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

-- |
-- Module      :  Sound.SoXBasics
-- Copyright   :  (c) OleksandrZhabenko 2019-2021
-- 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.
--


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

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

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

getMaxA :: String -> (Int, Int) -> IO String
getMaxA = ULencode -> String -> (Int, Int) -> IO String
getMaxAG ULencode
W

getMinA :: String -> (Int, Int) -> IO String
getMinA = ULencode -> String -> (Int, Int) -> IO String
getMinAG ULencode
W

selMaxAbs :: String -> (Int, Int) -> IO (String, Bool)
selMaxAbs = ULencode -> String -> (Int, Int) -> IO (String, Bool)
selMaxAbsG ULencode
W

selMA :: String -> (Int, Int) -> Bool -> IO String
selMA = ULencode -> String -> (Int, Int) -> Bool -> IO String
selMAG ULencode
W

extremeS :: String -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int
extremeS = ULencode
-> String -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int
extremeSG ULencode
W

extremeS1 :: String -> IO Int
extremeS1 = ULencode -> String -> IO Int
extremeSG1G ULencode
W

soxStat :: String -> IO ()
soxStat = ULencode -> String -> IO ()
soxStatG ULencode
W

upperBnd :: String -> IO Int
upperBnd = ULencode -> String -> IO Int
upperBndG ULencode
W

durationA :: String -> IO Float
durationA = ULencode -> String -> IO Float
durationAG ULencode
W

sampleAn :: String -> Integer -> IO (String, String)
sampleAn = ULencode -> String -> Integer -> IO (String, String)
sampleAnG ULencode
W

alterVadB :: String -> Float -> Int -> Float -> IO ()
alterVadB = ULencode -> String -> Float -> Int -> Float -> IO ()
alterVadBG ULencode
W

alterVadE :: String -> Float -> Int -> Float -> IO ()
alterVadE = ULencode -> String -> Float -> Int -> Float -> IO ()
alterVadEG ULencode
W

alterVadHelp :: String -> Float -> Float -> Int -> Float -> IO ()
alterVadHelp = ULencode -> String -> Float -> Float -> Int -> Float -> IO ()
alterVadHelpG ULencode
W

opFile :: String -> String -> Float -> Int -> IO ()
opFile = ULencode -> String -> String -> Float -> Int -> IO ()
opFileG ULencode
W

norm :: String -> IO ()
norm = ULencode -> String -> IO ()
normG ULencode
W

normL :: String -> Int -> IO ()
normL = ULencode -> String -> Int -> IO ()
normLG ULencode
W

gainL :: String -> Float -> IO ()
gainL = ULencode -> String -> Float -> IO ()
gainLG ULencode
W

quarterSinFade :: String -> IO ()
quarterSinFade = ULencode -> String -> IO ()
quarterSinFadeG ULencode
W

silenceBoth :: String -> Int -> Int -> IO ()
silenceBoth = ULencode -> String -> Int -> Int -> IO ()
silenceBothG ULencode
W

resampleA :: String -> Int -> IO ()
resampleA = ULencode -> String -> Int -> IO ()
resampleAG ULencode
W

noiseProfB :: String -> IO ()
noiseProfB = ULencode -> String -> IO ()
noiseProfBG ULencode
W

noiseProfE :: String -> IO ()
noiseProfE = ULencode -> String -> IO ()
noiseProfEG ULencode
W

noiseReduceB :: String -> IO ()
noiseReduceB = ULencode -> String -> IO ()
noiseReduceBG ULencode
W

noiseReduceE :: String -> IO ()
noiseReduceE = ULencode -> String -> IO ()
noiseReduceEG ULencode
W

noiseReduceBU :: String -> Float -> IO ()
noiseReduceBU = ULencode -> String -> Float -> IO ()
noiseReduceBUG ULencode
W

noiseReduceEU :: String -> Float -> IO ()
noiseReduceEU = ULencode -> String -> Float -> IO ()
noiseReduceEUG ULencode
W

sincA :: String -> IO ()
sincA = ULencode -> String -> IO ()
sincAG ULencode
W

volS :: String -> Float -> IO ()
volS = ULencode -> String -> Float -> IO ()
volSG ULencode
W

volS2 :: String -> String -> IO ()
volS2 = ULencode -> String -> String -> IO ()
volS2G ULencode
W