-- |
-- Module      :  SoXBasics1.Arr
-- Copyright   :  (c) OleksandrZhabenko 2020-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). 
-- This module differs from a SoXBasics that the resulting files
-- in it have possibly just the same name as the input ones. The functions
-- try to replace the initial file with the processed one.
-- 


module SoXBasics1.Arr (
  -- * Produce sound
  -- ** Amplitude modification
  norm
  , normL
  , gainL
  , quarterSinFade
  -- ** Adding silence
  , silenceBoth
  -- ** Changing sample rate
  , resampleA
  -- ** Working with noise
  , noiseReduceB
  , noiseReduceE
  , noiseReduceBU
  , noiseReduceEU
  -- ** Filtering
  , sincA
  -- ** Volume amplification
  , volS
  , volS2
) where

import System.Directory
import Data.Maybe (isJust, fromJust)
import Numeric
import System.Process
import EndOfExe
import System.Exit
import qualified SoXBasics.Arr as SB (extremeS1,upperBnd,selMA,maxAbs,norm)
import Sound.Control.Exception.FinalException

-- | 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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
norm :: FilePath -> IO ()
norm :: FilePath -> IO ()
norm FilePath
file = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"norm"] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"norm")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"norm")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
normL :: FilePath -> Int -> IO ()
normL :: FilePath -> Int -> IO ()
normL FilePath
file Int
level = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"gain", FilePath
"-n", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
level] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"gain -n")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"gain -n")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
gainL :: FilePath -> Float -> IO ()
gainL :: FilePath -> Float -> IO ()
gainL FilePath
file Float
level = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"gain", FilePath
"-b", Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6) Float
level (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"gain -b")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"gain -b")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"9" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | 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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
quarterSinFade :: FilePath -> IO ()
quarterSinFade :: FilePath -> IO ()
quarterSinFade FilePath
file = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    Int
pos <- FilePath -> IO Int
SB.extremeS1 FilePath
file
    Int
upp <- FilePath -> IO Int
SB.upperBnd FilePath
file
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"4" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"fade", FilePath
"q", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
pos FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"s", FilePath
"=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
upp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"s", Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
upp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"s"] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"4" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"4" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"fade q")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"fade q")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"4" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"4" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
silenceBoth :: FilePath -> Int -> Int -> IO ()
silenceBoth :: FilePath -> Int -> Int -> IO ()
silenceBoth FilePath
file Int
beginning Int
end = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"delay", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
beginning FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"s", FilePath
"reverse"] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffects FilePath
"delay reverse")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffects FilePath
"delay reverse")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            (ExitCode
code1, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"2" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"delay", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
end FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"s", FilePath
"reverse"] FilePath
""
            if ExitCode
code1 ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
              then do
                Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"2" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                if Bool
e2
                  then do
                    FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                    FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"2" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                    FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreated FilePath
file)
                  else do
                    FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                    FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreated FilePath
file)
              else do
                Bool
e3 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"2" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                if Bool
e3
                  then do
                    FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                    FilePath -> IO ()
removeFile FilePath
file
                    FilePath -> FilePath -> IO ()
renameFile (FilePath
"2" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
                  else do
                    FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                    FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreated FilePath
file)
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
file)
  else 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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
resampleA :: FilePath -> Int -> IO ()
resampleA :: FilePath -> Int -> IO ()
resampleA FilePath
file Int
frequency = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"rate", FilePath
"-s", FilePath
"-I", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
frequency] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"rate")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"rate")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"3" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
noiseReduceB :: FilePath -> IO ()
noiseReduceB :: FilePath -> IO ()
noiseReduceB FilePath
file = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox")
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"noisered", FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".b.prof"] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"noisered")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"noisered")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
noiseReduceE :: FilePath -> IO ()
noiseReduceE :: FilePath -> IO ()
noiseReduceE FilePath
file = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"noisered", FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".e.prof"] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"noisered")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"noisered")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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. While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
noiseReduceBU :: FilePath -> Float -> IO ()
noiseReduceBU :: FilePath -> Float -> IO ()
noiseReduceBU FilePath
file Float
amount = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox")
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"noisered", FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".b.prof", Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
amount (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"noisered")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"noisered")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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 '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). 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. While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
noiseReduceEU :: FilePath -> Float -> IO ()
noiseReduceEU :: FilePath -> Float -> IO ()
noiseReduceEU FilePath
file Float
amount = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"noisered", FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".e.prof",  Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
amount (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"noisered")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"noisered")
      else do 
        Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e2 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"_." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
volS :: FilePath -> Float -> IO ()
volS :: FilePath -> Float -> IO ()
volS FilePath
file Float
amplitude = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    FilePath -> IO ()
SB.norm FilePath
file
    Bool
e0 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
    if Bool
e0
      then do
        (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"vol", Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplitude (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0, FilePath
"amplitude"] FilePath
""
        if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
          then do
            Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            if Bool
e1
              then do
                FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"vol")
              else do
                FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"vol")
          else do 
            Bool
e2 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            if Bool
e2 
              then do
                FilePath -> IO ()
removeFile FilePath
file
                FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                FilePath -> FilePath -> IO ()
renameFile (FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
              else do 
                FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"8" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
                FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
file)
      else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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). While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
volS2 :: FilePath -> FilePath -> IO ()
volS2 :: FilePath -> FilePath -> IO ()
volS2 FilePath
fileA FilePath
fileB = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    Int
upp <- FilePath -> IO Int
SB.upperBnd FilePath
fileB
    FilePath
amplMax <- FilePath -> (Int, Int) -> Bool -> IO FilePath
SB.selMA FilePath
fileB (Int
0, Int
upp) Bool
True
    FilePath
amplMin <- FilePath -> (Int, Int) -> Bool -> IO FilePath
SB.selMA FilePath
fileB (Int
0, Int
upp) Bool
False
    let ampl :: Float
ampl = FilePath -> Float
forall a. Read a => FilePath -> a
read ((FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, Bool) -> FilePath)
-> ((FilePath, FilePath) -> (FilePath, Bool))
-> (FilePath, FilePath)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> (FilePath, Bool)
SB.maxAbs ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath) -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath
amplMax, FilePath
amplMin))::Float
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
fileA, FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
fileA, FilePath
"vol", Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
ampl (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0, FilePath
"amplitude"] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
fileA
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
fileA
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"vol")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"vol")
      else do 
        Bool
file8e <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
fileA
        if Bool
file8e 
          then do
            FilePath -> IO ()
removeFile FilePath
fileA
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"8." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
fileA) FilePath
fileA
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
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. While being
-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not
-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification.
sincA :: FilePath -> IO ()
sincA :: FilePath -> IO ()
sincA FilePath
file = if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") 
  then do
    (ExitCode
code, FilePath
_, FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"4." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file, FilePath
"sinc", FilePath
"-a", FilePath
"50", FilePath
"-I", FilePath
"0.07k-11k"] FilePath
""
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
      then do
        Bool
e1 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"4." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e1
          then do
            FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"4." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
            FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"sinc")
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotCreatedWithEffect FilePath
"sinc")
      else do 
        Bool
e0 <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"4." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file
        if Bool
e0 
          then do
            FilePath -> IO ()
removeFile FilePath
file
            FilePath -> FilePath -> IO ()
renameFile (FilePath
"4." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file) FilePath
file
          else FinalException -> IO ()
catchEnd (FilePath -> FinalException
InitialFileNotChanged FilePath
file)
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled