-- |
-- Module      :  SoXBasics.Arr
-- Copyright   :  (c) OleksandrZhabenko 2019-2022, 2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@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 EndOfExe2
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 :: ([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] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
&& [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
ys 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] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' Bool -> Bool -> Bool
&& [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
ys 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] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
&& [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
ys Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' = if [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [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 ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
ys) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then ([Char]
xs, Bool
True) else ([Char]
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 :: [Char] -> (Int, Int) -> IO [Char]
getMaxA [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) <- [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]
"-n", [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"] [Char]
""
    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 [Char] -> Char
forall a. HasCallStack => [a] -> a
head [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 '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 :: [Char] -> (Int, Int) -> IO [Char]
getMinA [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) <- [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]
"-n", [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"] [Char]
""
    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 [Char] -> Char
forall a. HasCallStack => [a] -> a
head [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 '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 :: [Char] -> (Int, Int) -> IO ([Char], Bool)
selMaxAbs [Char]
file (Int
lowerbnd, Int
upperbnd) = do 
  [Char]
tX <- [Char] -> (Int, Int) -> IO [Char]
getMaxA [Char]
file (Int
lowerbnd, Int
upperbnd)
  [Char]
tN <- [Char] -> (Int, Int) -> IO [Char]
getMinA [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 '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 :: [Char] -> (Int, Int) -> Bool -> IO [Char]
selMA [Char]
file (Int
lowerbnd, Int
upperbnd) Bool
x = if Bool
x then [Char] -> (Int, Int) -> IO [Char]
getMaxA [Char]
file (Int
lowerbnd, Int
upperbnd) else [Char] -> (Int, Int) -> IO [Char]
getMinA [Char]
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 :: [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeS [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 <- [Char] -> (Int, Int) -> Bool -> IO [Char]
selMA [Char]
file (Int
lowerbnd, Int
t) Bool
z
    if ([Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
rs) 
         then [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeS [Char]
file (Int
lowerbnd, Int
t) Int
eps IO ([Char], Bool)
x
         else [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeS [Char]
file (Int
t, Int
upperbnd) Int
eps IO ([Char], 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 :: [Char] -> Float -> Int -> Float -> IO ()
alterVadB [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 <- [Char] -> IO Float
durationA [Char]
file
         [Char] -> Float -> Float -> Int -> Float -> IO ()
alterVadHelp [Char]
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 :: [Char] -> Float -> Float -> Int -> Float -> IO ()
alterVadHelp [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 = [Char] -> Float -> Int -> Float -> IO ()
alterVadB [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) <- [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]
"-n", [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"] [Char]
""
       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]
_) <- [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]
"7" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [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"] [Char]
""
            if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
              then do
                Int -> IO ()
threadDelay Int
100000
                [Char] -> Float -> Int -> IO ()
opFile [Char]
file Float
exit Int
noiseMax
              else do
                Bool
e0 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"7" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                if Bool
e0
                  then do
                    [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"7" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                    FinalException -> IO ()
catchEnd FinalException
MaybePartiallyTrimmed
                  else FinalException -> IO ()
catchEnd FinalException
MaybePartiallyTrimmed
          else [Char] -> Float -> Int -> Float -> IO ()
alterVadB [Char]
file (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) <- [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]
"-n", [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"] [Char]
""
       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]
_) <- [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]
"7" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [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"] [Char]
""
            if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
              then do
                Int -> IO ()
threadDelay Int
100000
                [Char] -> Float -> Int -> IO ()
opFile [Char]
file Float
exit Int
noiseMax
              else do
                Bool
e0 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"7" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                if Bool
e0
                  then do
                    [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"7" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                    FinalException -> IO ()
catchEnd FinalException
MaybePartiallyTrimmed
                  else FinalException -> IO ()
catchEnd FinalException
MaybePartiallyTrimmed
          else [Char] -> Float -> Int -> Float -> IO ()
alterVadB [Char]
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 :: [Char] -> Float -> Int -> IO ()
opFile [Char]
file Float
exit Int
noiseMax = do
  [Char] -> IO ()
removeFile [Char]
file
  Bool
exist0 <- [Char] -> IO Bool
doesFileExist [Char]
file
  if Bool -> Bool
not Bool
exist0 
    then do 
      [Char] -> [Char] -> IO ()
renameFile ([Char]
"7" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file) [Char]
file
      Float
lim2 <- [Char] -> IO Float
durationA [Char]
file
      [Char] -> Float -> Int -> Float -> IO ()
alterVadB [Char]
file Float
lim2 Int
noiseMax Float
exit
    else [Char] -> Float -> Int -> IO ()
opFile [Char]
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 :: [Char] -> IO ()
norm [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- [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]
"8" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"norm"] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [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
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"8" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"norm")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"norm")
      else do 
        Bool
e2 <- [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
e2 
          then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> Int -> IO ()
normL [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]
_) <- [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]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"gain", [Char]
"-n", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
level] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"gain -n")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"gain -n")
      else do 
        Bool
e2 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> Float -> IO ()
gainL [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]
_) <- [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]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [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] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"gain -b")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"gain -b")
      else do 
        Bool
e2 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"9" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 ([Char] -> FinalException
InitialFileNotChanged [Char]
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'soxStat' prints a SoX statistics for the audio file.
soxStat :: FilePath -> IO ()
soxStat :: [Char] -> IO ()
soxStat [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
  then do 
    (ExitCode
_, [Char]
_, [Char]
herr) <- [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]
"-n", [Char]
"stat"] [Char]
""
    [Char] -> IO ()
putStrLn [Char]
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 :: [Char] -> Float -> Int -> Float -> IO ()
alterVadE [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]
_) <- [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]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"reverse"] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
      then do
        Bool
e0 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e0
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreated [Char]
file)
          else do
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreated [Char]
file)
      else do
        [Char] -> Float -> Int -> Float -> IO ()
alterVadB ([Char]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file) Float
lim Int
noiseMax Float
exit
        (ExitCode
code1, [Char]
_, [Char]
_) <- [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]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"76" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"reverse"] [Char]
""
        if ExitCode
code1 ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
          then do
            Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"76" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            if Bool
e1
              then do
                [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"76" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreated [Char]
file)
              else do
                [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreated [Char]
file)
          else do
            Bool
e2 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"76" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            if Bool
e2
              then do
                [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                [Char] -> IO ()
removeFile [Char]
file
                [Char] -> [Char] -> IO ()
renameFile ([Char]
"76" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file) [Char]
file
              else do
                [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"6" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreated [Char]
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 :: [Char] -> IO Int
upperBnd [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")) [[Char]
"-s",[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 'extremeS' with all the additional information included.
extremeS1 :: FilePath -> IO Int
extremeS1 :: [Char] -> IO Int
extremeS1 [Char]
file = do
  Int
upp <- [Char] -> IO Int
upperBnd [Char]
file
  [Char] -> (Int, Int) -> Int -> IO ([Char], Bool) -> IO Int
extremeS [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) ([Char] -> (Int, Int) -> IO ([Char], Bool)
selMaxAbs [Char]
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 :: [Char] -> IO ()
quarterSinFade [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
  then do
    Int
pos <- [Char] -> IO Int
extremeS1 [Char]
file
    Int
upp <- [Char] -> IO Int
upperBnd [Char]
file
    (ExitCode
code, [Char]
_, [Char]
_) <- [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]
"4" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [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"] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"4" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"4" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"fade q")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"fade q")
      else do 
        Bool
e2 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"4" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> Int -> Int -> IO ()
silenceBoth [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])
_ <- [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]
"3" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [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"] [Char]
""
    (ExitCode, [Char], [Char])
_ <- [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]
"3" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"2" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [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]
""
    [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"3" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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 :: [Char] -> Float -> IO ()
recA [Char]
file Float
x | Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") Bool -> Bool -> Bool
&& 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" = do 
  (ExitCode
code, [Char]
_, [Char]
_) <- [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]
"-t",[Char]
"waveaudio",[Char]
"-d",[Char]
"-b16", [Char]
"-c1", [Char]
"-esigned-integer", [Char]
"-L", [Char]
file, [Char]
"trim", [Char]
"0.5", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0] [Char]
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- [Char] -> IO Bool
doesFileExist [Char]
file
      if Bool
e0
        then do
          [Char] -> IO ()
removeFile [Char]
file
          FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
        else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
    else do
      Bool
e1 <- [Char] -> IO Bool
doesFileExist [Char]
file
      if Bool
e1
        then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
            | Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"rec") = do
  (ExitCode
code, [Char]
_, [Char]
_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"rec")) [[Char]
"-b16", [Char]
"-c1", [Char]
"-esigned-integer", [Char]
"-L", [Char]
file, [Char]
"trim", [Char]
"0.5", Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0] [Char]
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- [Char] -> IO Bool
doesFileExist [Char]
file
      if Bool
e0
        then do
          [Char] -> IO ()
removeFile [Char]
file
          FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
        else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
    else do
      Bool
e1 <- [Char] -> IO Bool
doesFileExist [Char]
file
      if Bool
e1
        then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
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 :: [Char] -> (Float, Float) -> IO ()
recB [Char]
file (Float
x, Float
y) | Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") Bool -> Bool -> Bool
&& 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" = do 
  (ExitCode
code, [Char]
_, [Char]
_) <- [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]
"-t",[Char]
"waveaudio",[Char]
"-d",[Char]
"-b16", [Char]
"-c1", [Char]
"-esigned-integer", [Char]
"-L", [Char]
file, [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
y ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0, Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0] [Char]
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- [Char] -> IO Bool
doesFileExist [Char]
file
      if Bool
e0
        then do
          [Char] -> IO ()
removeFile [Char]
file
          FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
        else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
    else do
      Bool
e1 <- [Char] -> IO Bool
doesFileExist [Char]
file
      if Bool
e1
        then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
                 | Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"rec") = do
  (ExitCode
code, [Char]
_, [Char]
_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"rec")) [[Char]
"-b16", [Char]
"-c1", [Char]
"-esigned-integer", [Char]
"-L", [Char]
file, [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
y ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0, Maybe Int -> Float -> [Char] -> [Char]
forall a. RealFloat a => Maybe Int -> a -> [Char] -> [Char]
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
0] [Char]
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- [Char] -> IO Bool
doesFileExist [Char]
file
      if Bool
e0
        then do
          [Char] -> IO ()
removeFile [Char]
file
          FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
        else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
file)
    else do
      Bool
e1 <- [Char] -> IO Bool
doesFileExist [Char]
file
      if Bool
e1
        then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotRecorded [Char]
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 :: [Char] -> Int -> IO ()
resampleA [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]
_) <- [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]
"3" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"rate", [Char]
"-s", [Char]
"-I", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
frequency] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"3" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"3" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"rate")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"rate")
      else do 
        Bool
e2 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"3" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 ([Char] -> FinalException
InitialFileNotChanged [Char]
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function 'durationA' returns a duration of the audio file in seconds.
durationA :: FilePath -> IO Float
durationA :: [Char] -> IO Float
durationA [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")) [[Char]
"-D",[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 '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

-- | 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 :: [Char] -> IO ()
noiseProfB [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- [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]
"-n", [Char]
"trim", [Char]
"0", [Char]
"0.05", [Char]
"noiseprof",[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".b.prof"] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
      then do
        Bool
e0 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".b.prof"
        if Bool
e0
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".b.prof"
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NoiseProfileNotCreatedB [Char]
file)
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NoiseProfileNotCreatedB [Char]
file)
      else do 
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".b.prof"
        if Bool
e1
          then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NoiseProfileNotCreatedB [Char]
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 :: [Char] -> IO ()
noiseProfE [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- [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]
"-n", [Char]
"trim", [Char]
"-0.05", [Char]
"0.05", [Char]
"noiseprof",[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".e.prof"] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
      then do
        Bool
e0 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".e.prof"
        if Bool
e0
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".e.prof"
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NoiseProfileNotCreatedE [Char]
file)
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NoiseProfileNotCreatedE [Char]
file)
      else do 
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".e.prof"
        if Bool
e1
          then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NoiseProfileNotCreatedE [Char]
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 :: [Char] -> IO ()
noiseReduceB [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox")
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- [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]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"noisered", [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".b.prof"] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered")
      else do 
        Bool
e2 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> IO ()
noiseReduceE [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- [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]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"noisered", [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".e.prof"] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered")
      else do 
        Bool
e2 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> Float -> IO ()
noiseReduceBU [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]
_) <- [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]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"noisered", [Char]
file [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] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered")
      else do 
        Bool
e2 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> Float -> IO ()
noiseReduceEU [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]
_) <- [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]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"noisered", [Char]
file [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] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"noisered")
      else do 
        Bool
e2 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"_." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> Float -> IO ()
volS [Char]
file Float
amplitude = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
  then do
    [Char] -> IO ()
norm [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]
_) <- [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]
"8" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"8." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [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"] [Char]
""
        if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
          then do
            Bool
e1 <- [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
e1
              then do
                [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"8." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"8" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"vol")
              else do
                [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"8" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"vol")
          else do 
            Bool
e2 <- [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
e2 
              then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              else do 
                [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"8" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
                FinalException -> IO ()
catchEnd ([Char] -> FinalException
InitialFileNotChanged [Char]
file)
      else FinalException -> IO ()
catchEnd ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> [Char] -> IO ()
volS2 [Char]
fileA [Char]
fileB = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
  then do
    Int
upp <- [Char] -> IO Int
upperBnd [Char]
fileB
    [Char]
amplMax <- [Char] -> (Int, Int) -> Bool -> IO [Char]
selMA [Char]
fileB (Int
0, Int
upp) Bool
True
    [Char]
amplMin <- [Char] -> (Int, Int) -> Bool -> IO [Char]
selMA [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]
_) <- [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]
fileA, [Char]
"8." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
fileA, [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"] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [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] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
fileA
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"8." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
fileA
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"vol")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"vol")
      else do 
        Bool
file8e <- [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] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
fileA
        if Bool
file8e 
          then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> IO ()
sincA [Char]
file = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
  then do
    (ExitCode
code, [Char]
_, [Char]
_) <- [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]
"4." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file, [Char]
"sinc", [Char]
"-a", [Char]
"50", [Char]
"-I", [Char]
"0.07k-11k"] [Char]
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"4." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e1
          then do
            [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"4." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
            FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"sinc")
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
NotCreatedWithEffect [Char]
"sinc")
      else do 
        Bool
e0 <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"4." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file
        if Bool
e0 
          then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else FinalException -> IO ()
catchEnd ([Char] -> FinalException
InitialFileNotChanged [Char]
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 :: [Char] -> Integer -> IO ([Char], [Char])
sampleAn [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")) [[Char]
"-s", [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) <- [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]
"-n", [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"] [Char]
""
          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]
"")