-- |
-- 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 approximately Ukrainian speech 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

-- | 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)
{-# INLINE selMA #-}

-- | 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
{-# INLINE extremeS #-}

-- | 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).
alterVadB :: FilePath -> Double -> IO ()
alterVadB file lim = if isJust (showE "sox") && isJust (showE "soxi")
  then do
    (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", "0", showFFloat Nothing lim $ show 0, "stat"] ""
  --  (_, Just hout, _, _) <- createProcess (proc (fromJust (showE "soxi")) ["-d",file]){ std_out = CreatePipe }
    --y0 <- hGetContents hout
    let zs = lines herr in let z = concatMap (dropWhile (not . isDigit)) . take 1 . drop 3 $ zs in if z < "0.04"
      then readProcessWithExitCode (fromJust (showE "sox")) [file, "7" ++ file, "trim", showFFloat Nothing lim $ show 0, "-0.000"] "" >> return ()
      else alterVadB file (lim / 2.0)
  else error "SoX is not properly installed in your system. Please, install it properly and then call the function again."

-- | 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).
alterVadE :: FilePath -> Double -> IO ()
alterVadE file lim = if isJust (showE "sox")
  then do
    _ <- readProcessWithExitCode (fromJust (showE "sox")) [file, "6" ++ file, "reverse"] ""
    alterVadB ("6" ++ file) lim
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["76" ++ file, "6" ++ file, "reverse"] ""
    removeFile $ "76" ++ 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 'cleanTemp' removes all the intermediate temporary files in the directory where it is called from.
cleanTemp :: IO ()
cleanTemp = do
  filenames <- getDirectoryContents =<< getCurrentDirectory
  let rems = filter (\x -> head x `elem` (['2'..'9'] ++ "_" ++ "x")) filenames in mapM_ removeFile rems

-- | 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) 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
    norm fileA
    upp <- upperBnd fileB
    amplMax <- selMA fileB (0, upp) True
    amplMin <- selMA fileB (0, upp) False
    let ampl = read (fst . maxAbs $ (amplMax, amplMin))::Double
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["8" ++ fileA, "8." ++ fileA, "vol", showFFloat Nothing ampl $ show 0, "amplitude", "0.01"] ""
    removeFile $ "8" ++ fileA
  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."