-- |
-- Module      :  SoXBasics
-- Copyright   :  (c) OleksandrZhabenko 2019
-- License     :  MIT
--
-- 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 close to proper Ukrainian speech (if you pronounce the sounds properly) with 
-- your own recorded voice.
--

module SoXBasics where

import System.Directory
import Data.Maybe (isJust, fromJust)
import Numeric
import Data.Char
import System.Process
import System.IO
import EndOfExe
import System.Exit
import Control.Concurrent (threadDelay)

-- | 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 (xs, ys) | null xs || null ys = ([], False)
                | head xs == '-' && head ys == '-' = if compare xs ys /= LT then (xs, False) else (ys, False)
                | head xs /= '-' && head ys /= '-' = if compare xs ys == GT then (xs, True) else (ys, True)
                | head xs == '-' && head ys /= '-' = if compare (tail xs) ys /= LT then (xs, False) else (ys, True)
                | otherwise = if compare xs (tail ys) == GT then (xs, True) else (ys, False)

-- | Function 'getMaxA' returns a maximum amplitude of the sound in the file in the given lower and upper bounds represented as a tuple of @Int@ values.
getMaxA :: FilePath -> (Int, Int) -> IO String
getMaxA file (lowerbound, upperbound) = if isJust (showE "sox")
  then do
    (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", show lowerbound ++ "s", "=" ++ show upperbound ++ "s", "stat"] ""
    let zs = lines herr in return (let u = (words $ zs !! 3) !! 2 in if head u == '-' then take 9 u else take 8 u)
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'getMinA' returns a minimum amplitude of the sound in the file in the given lower and upper bounds represented as a tuple of @Int@ values.  
getMinA :: FilePath -> (Int, Int) -> IO String
getMinA file (lowerbound, upperbound) = if isJust (showE "sox")
  then do
    (_, _, herr1) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", show lowerbound ++ "s", "=" ++ show upperbound ++ "s", "stat"] ""
    let zs = lines herr1 in return (let u = (words $ zs !! 4) !! 2 in if head u == '-' then take 9 u else take 8 u)
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'selMaxAbs' returns a maximum by absolute value amplitude of the sound and allows by its second value in the tuple determine whether it is a maximum or minimum. 
-- Bool @True@ corresponds to maximum value, @False@ - to minimum value.
selMaxAbs :: FilePath -> (Int, Int) -> IO (String, Bool)
selMaxAbs file (lowerbnd, upperbnd) = do
  tX <- getMaxA file (lowerbnd, upperbnd)
  tN <- getMinA file (lowerbnd, upperbnd)
  return (maxAbs (tX, tN))

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

-- | Function 'extremeS' returns an approximate sample number of the extremum, which will be used further for fade effect.
extremeS :: FilePath -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int
extremeS file (lowerbnd, upperbnd) eps x = if compare (upperbnd - lowerbnd) (eps + 33) == LT
  then return $ (upperbnd + lowerbnd) `quot` 2
  else do
    (ys, z) <- x
    let t = (lowerbnd + upperbnd) `quot` 2
    rs <- selMA file (lowerbnd, t) z
    if (ys == rs)
         then extremeS file (lowerbnd, t) eps x
         else extremeS file (t, upperbnd) eps x

-- | Function 'alterVadB' removes an approximate silence measured by the absolute value of the sound amplitude from the beginning of the file. 
-- The function must be used with the @FilePath@ parameter containing no directories in its name (that mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from). The file must have maximum amplitude absolute value close to 1 before call to the 'alterVadB'. 
-- The second @Double@ parameter is used to exit the iteration cycle.
alterVadB :: FilePath -> Double -> Double -> IO ()
alterVadB file lim exit | compare lim exit /= GT = putStrLn $ "File " ++ file ++ " is ready for further processing."
                        | otherwise =
 if isJust (showE "sox")
  then do
    lim1 <- durationA file
    case (compare lim1 lim) of
      LT -> alterVadB file lim1 exit
      EQ -> do
        (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", "0", showFFloat Nothing (lim1 / 2.0) $ show 0, "stat"] ""
        let zs = lines herr in let z = concatMap (dropWhile (not . isDigit)) . take 1 . drop 3 $ zs in if z < "0.04"
          then do
            (_, _, herr3) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "7" ++ file, "trim", showFFloat Nothing (lim1 / 2.0) $ show 0, "-0.000000"] ""
            threadDelay 100000
            opFile file exit
          else alterVadB file (lim1 / 4.0) exit
      _  -> do
        (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", "0", showFFloat Nothing (lim / 2.0) $ show 0, "stat"] ""
        let zs = lines herr in let z = concatMap (dropWhile (not . isDigit)) . take 1 . drop 3 $ zs in if z < "0.04"
          then do
            (_, _, herr3) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "7" ++ file, "trim", showFFloat Nothing (lim / 2.0) $ show 0, "-0.000000"] ""
            threadDelay 100000
            opFile file exit
          else alterVadB file (lim / 4.0) exit
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

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

-- | 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 mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from).
norm :: FilePath -> IO ()
norm file = if isJust (showE "sox")
  then readProcessWithExitCode (fromJust (showE "sox")) [file, "8" ++ file, "norm"] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | 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 mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from).
normL :: FilePath -> Int -> IO ()
normL file level = if isJust (showE "sox")
  then readProcessWithExitCode (fromJust (showE "sox")) [file, "9" ++ file, "gain", "-n", show level] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'soxStat' prints a SoX statistics for the audio file.
soxStat :: FilePath -> IO ()
soxStat file = if isJust (showE "sox")
  then do
    (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "stat"] ""
    putStrLn herr
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | 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 mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from). The second @Double@ parameter is used to exit the iteration cycle.
alterVadE :: FilePath -> Double -> Double -> IO ()
alterVadE file lim exit | compare lim exit /= GT = putStrLn $ "File " ++ file ++ " is ready for further processing"
                        | otherwise =
 if isJust (showE "sox")
  then do
    _ <- readProcessWithExitCode (fromJust (showE "sox")) [file, "6" ++ file, "reverse"] ""
    alterVadB ("6" ++ file) lim exit
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["6" ++ file, "76" ++ file, "reverse"] ""
    removeFile $ "6" ++ file
    renameFile ("76" ++ file) file
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'upperBnd' returns a maximum number of samples for use in other functions.
upperBnd :: FilePath -> IO Int
upperBnd file = if isJust (showE "soxi")
  then do
    (_, Just hout, _, _) <- createProcess (proc (fromJust (showE "soxi")) ["-s",file]){ std_out = CreatePipe }
    x0 <- hGetContents hout
    let z = read x0::Int in return z
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Variant of the function 'extremeS' with all the additional information included.
extremeS1 :: FilePath -> IO Int
extremeS1 file = do
  upp <- upperBnd file
  extremeS file (0::Int, upp) (if upp `quot` 32 > 2 then upp `quot` 32 else 2::Int) (selMaxAbs file (0::Int, upp))

-- | Function 'quarterSinFade' applies a fade effect by SoX to the audio file with \"q\" type. 
-- The function must be used with the @FilePath@ parameter containing no directories in its name (that mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from).
quarterSinFade :: FilePath -> IO ()
quarterSinFade file = if isJust (showE "sox")
  then do
    pos <- extremeS1 file
    upp <- upperBnd file
    _ <- readProcessWithExitCode (fromJust (showE "sox")) [file, "4" ++ file, "fade", "q", show pos ++ "s", "=" ++ show upp ++ "s", show (upp - pos) ++ "s"] ""
    return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'silenceBoth' adds a silence to both ends of the audio. 
-- The function must be used with the @FilePath@ parameter containing no directories in its name (that mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from).
silenceBoth :: FilePath -> Int -> Int -> IO ()
silenceBoth file beginning end = if isJust (showE "sox")
  then do
    _ <- readProcessWithExitCode (fromJust (showE "sox")) [file, "3" ++ file, "delay", show beginning ++ "s", "reverse"] ""
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["3" ++ file, "2" ++ file, "delay", show end ++ "s", "reverse"] ""
    removeFile $ "3" ++ file
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'recA' records audio file with the given name and duration in seconds
recA :: FilePath -> Double -> IO ()
recA file x = if isJust (showE "rec")
  then readProcessWithExitCode (fromJust (showE "rec")) ["-b16", "-c1", "-e", "signed-integer", "-L", file, "trim", "0.5", showFFloat Nothing x $ show 0] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | 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 mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from).
resampleA :: FilePath -> Int -> IO ()
resampleA file frequency = if isJust (showE "sox")
  then readProcessWithExitCode (fromJust (showE "sox")) [file, "3" ++ file, "rate", "-s", "-I", show frequency] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'durationA' returns a duration of the audio file in seconds
durationA :: FilePath -> IO Double
durationA file = if isJust (showE "soxi")
  then do
    (_, Just hout, _, _) <- createProcess (proc (fromJust (showE "soxi")) ["-D",file]){ std_out = CreatePipe }
    x0 <- hGetContents hout
    let z = read x0::Double in return z
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'playA' plays the given file with SoX
playA :: FilePath -> IO ()
playA file = if isJust (showE "play")
  then readProcessWithExitCode (fromJust (showE "play")) [file] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'noiseProfB' creates with SoX a file containing a noise profile for the first 0.05 s of the audio file given
noiseProfB :: FilePath -> IO ()
noiseProfB file = if isJust (showE "sox")
  then readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", "0", "0.05", "noiseprof",file ++ ".b.prof"] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'noiseProfE' creates with SoX a file containing a noise profile for the last 0.05 s of the audio file given. 
noiseProfE :: FilePath -> IO ()
noiseProfE file = if isJust (showE "sox")
  then readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", "-0.05", "0.05", "noiseprof",file ++ ".e.prof"] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | 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 mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from).
noiseReduceB :: FilePath -> IO ()
noiseReduceB file = if isJust (showE "sox")
  then readProcessWithExitCode (fromJust (showE "sox")) [file, "_" ++ file, "noisered", file ++ ".b.prof"] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | 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 mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from).
noiseReduceE :: FilePath -> IO ()
noiseReduceE file = if isJust (showE "sox")
  then readProcessWithExitCode (fromJust (showE "sox")) [file, "_." ++ file, "noisered", file ++ ".e.prof"] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | Function 'volS' changes the given audio with the linear ratio for the amplitude so that the resulting amlitude is equal to the given @Double@ parameter.
-- The function must be used with the @FilePath@ parameter containing no directories in its name (that mean the file of the @FilePath@ parameter must be 
-- in the same directory that also the function is called from).
volS :: FilePath -> Double -> IO ()
volS file amplitude = if isJust (showE "sox")
  then do
    norm file
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["8" ++ file, "8." ++ file, "vol", showFFloat Nothing amplitude $ show 0, "amplitude", "0.01"] ""
    removeFile $ "8" ++ file
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | 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 mean the file of the first @FilePath@ parameter must be in the same directory that also the function is called from).
volS2 :: FilePath -> FilePath -> IO ()
volS2 fileA fileB = if isJust (showE "sox")
  then do
    upp <- upperBnd fileB
    amplMax <- selMA fileB (0, upp) True
    amplMin <- selMA fileB (0, upp) False
    let ampl = read (fst . maxAbs $ (amplMax, amplMin))::Double
    (code, _, _) <- readProcessWithExitCode (fromJust (showE "sox")) [fileA, "8." ++ tail fileA, "vol", showFFloat Nothing ampl $ show 0, "amplitude"] ""
    if code /= ExitSuccess
      then error "File was not created with \"vol\" effect!"
      else do
        file8e <- doesFileExist $ "8." ++ tail fileA
        if file8e
          then removeFile fileA
          else error "Second error!"
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."


-- | Function 'sincA' uses a sinc effect with -a 50 -I 0.1k-11k band-pass filter for the audio file given.
sincA :: FilePath -> IO ()
sincA file = if isJust (showE "sox")
  then readProcessWithExitCode (fromJust (showE "sox")) [file, "4." ++ file, "sinc", "-a", "50", "-I", "0.1k-11k"] "" >> return ()
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."