-- |
-- Module      :  Processing_mmsyn7ukr
-- Copyright   :  (c) OleksandrZhabenko 2019-2020
-- 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 (actually it produces the needed sound representations).
--

module Processing_mmsyn7ukr (
  -- * Producing sound
  produceSound
  , produceSound2
  , produceSound3
  , produceSound4
  , beginProcessing
  -- * Additional functions
  , tempS
  , showCoef
  , tempeRa
  -- * Cleaning
  , cleanTemp
  , cleanTempN
) where

import Control.Concurrent (threadDelay)
import Numeric
import System.Directory
import Control.Exception (onException)
import EndOfExe (showE)
import Data.Maybe (fromJust)
import Data.Char
import qualified Data.Vector as V
import System.Process
import System.IO
import SoXBasics
import CaseBi (getBFst')

-- | Function that being given a tuple of @String@ and a path to the installed by the @mmsyn6ukr@ package file produces the corresponding analogous sound with your created 
-- voicing. The tuple controls the function behaviour. The first @String@ in it specifies the actions that will be performed to produce a sound file and the second one 
-- specifies a maximum absolute amplitude starting from which the sound will not be truncated if the 'alterVadB' and 'alterVadE' functions must be applied (that is specified 
-- by the first @String@ parameter). 
produceSound :: (String, String) -> FilePath -> IO ()
produceSound (actsctrl, noiseLim) file  = onException (do {
; let file1 = drop (length file - 5) file
      soundUkr = getBFst' ("е", V.fromList . zip ["A.wav", "B.wav", "C.wav", "D.wav", "E.wav", "F.wav", "G.wav", "H.wav",
        "I.wav", "J.wav", "K.wav", "L.wav", "M.wav", "N.wav", "O.wav", "P.wav", "Q.wav", "R.wav",
          "S.wav", "T.wav", "U.wav", "V.wav", "W.wav", "X.wav", "Y.wav", "Z.wav", "a.wav", "b.wav", "c.wav",
            "d.wav", "e.wav", "f.wav"] $ ["а", "б", "в", "г", "д", "дж", "дз", "е", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р",
               "с", "сь", "т", "у", "ф", "х", "ц", "ць", "ч", "ш", "ь", "і", "ґ"]) $ file1
; playA file
; putStrLn "The sound duration is: "
; produceSound2 (file, file1) (actsctrl, noiseLim) soundUkr
; return () }) (do
       putStrLn "Something went unexpectedly, please, repeat the precedure again, be attentive to the data you provide as input! "
       putStr "The needed files were NOT created (may be the sound was not at the moment of recording)! The process will be restarted "
       putStrLn "for the sound. Please, produce a sound during the first 3 seconds (after 0.5 second delay) or specify greater ratio or use \'sharp\' mode!"
       cleanTemp
       produceSound (actsctrl, noiseLim) file)


-- | Function 'produceSound3' is used internally in the 'produceSound2' function.
produceSound3 :: (String, String) -> (FilePath, FilePath) -> String -> (Int, Double) -> Double -> IO ()
produceSound3 (actsctrl, noiseLim) (file, file1) soundUkr (noiseMax, duration0) lim0 = case actsctrl of
    "-1" ->
      do
          lim1 <- durationA "8_x.wav"
          if lim1 <= 0.0
            then beginProcessing (file, file1) soundUkr (actsctrl, noiseLim)
            else do
              resampleA "8_x.wav" (22050::Int)
              produceSound4 (file, file1)  "38_x.wav"
    "0" ->
      do
          lim1 <- durationA "8_x.wav"
          if lim1 <= 0.0
            then beginProcessing (file, file1) soundUkr (actsctrl, noiseLim)
            else do
              resampleA "8_x.wav" (22050::Int)
              produceSound4 (file, file1)  "38_x.wav"
    "1" ->
      do
          alterVadB "8_x.wav" lim0 noiseMax (duration0*0.04)
          lim1 <- durationA "8_x.wav"
          if lim1 <= 0.0
            then beginProcessing (file, file1) soundUkr (actsctrl, noiseLim)
            else do
              alterVadE "8_x.wav" lim1 noiseMax (duration0*0.04)
              resampleA "8_x.wav" (22050::Int)
              produceSound4 (file, file1)  "38_x.wav"
    "2" ->
      do
          alterVadB "8_x.wav" lim0 noiseMax (duration0*0.04)
          lim1 <- durationA "8_x.wav"
          if lim1 <= 0.0
            then beginProcessing (file, file1) soundUkr (actsctrl, noiseLim)
            else do
              alterVadE "8_x.wav" lim1 noiseMax (duration0*0.04)
              sincA "8_x.wav"
              resampleA "4.8_x.wav" (22050::Int)
              produceSound4 (file, file1) "34.8_x.wav"
    _ ->
      do
          alterVadB "8_x.wav" lim0 noiseMax (duration0*0.04)
          lim1 <- durationA "8_x.wav"
          if lim1 <= 0.0
            then beginProcessing (file, file1) soundUkr (actsctrl, noiseLim)
            else do
              alterVadE "8_x.wav" lim1 noiseMax (duration0*0.1)
              sincA "8_x.wav"
              resampleA "4.8_x.wav" (22050::Int)
              quarterSinFade "34.8_x.wav"
              produceSound4 (file, file1) "434.8_x.wav"

-- | Function 'produceSound4' is used internally in the 'produceSound3' function for amplification 
-- up/down to the maximum level of the first @FilePath@ parameter in the tuple. The second one gives 
-- a name of the resulting file and the third @FilePath@ parameter of the function is the @FilePath@ for 
-- the input file.
produceSound4 :: (FilePath, FilePath) -> FilePath -> IO ()
produceSound4 (file, file1) fileB = do
  norm fileB
  volS2 ("8" ++ fileB) file
  renameFile ("8." ++ fileB) file1

-- | Function 'produceSound2' is used internally in the 'produceSound' function.
produceSound2 :: (FilePath, FilePath) -> (String, String) -> String -> IO ()
produceSound2 (file, file1) (actsctrl, noiseLim) soundUkr =
 do { duration0 <- durationA file
    ; (_, Just hout, _, _) <- createProcess (proc (fromJust . showE $ "soxi") ["-D", file]) { std_out = CreatePipe }
    ; x3 <- hGetContents hout
    ; putStrLn $ showCoef (showFFloat (Just 6) duration0 $ show 0)
    ; putStrLn ""
    ; putStrLn "It means that to produce more than 3 seconds of recording, you must specify at least "
    ; putStrLn $ "       " ++ show (3.0/duration0) ++ " as a next step ratio being prompt "
    ; putStrLn "       OR "
    ; putStrLn $ "       " ++ show (1.0/duration0) ++ " per one second but not less than the previous number."
    ; putStrLn $ "For example for 10 seconds record, please, specify " ++ show (10.0/duration0) ++ " as a next step ratio."
    ; (longerK0,sharp) <- tempS soundUkr
    ; let longerK = (read x3::Double)*longerK0
    ; putStrLn "Please, wait for 0.5 second and pronounce the sound representation for the "
    ; putStrLn ""
    ; putStrLn $ "                                                             \"" ++ (if soundUkr /= "ь" then map toUpper soundUkr else soundUkr) ++ "\""
    ; putStrLn ""
    ; putStrLn " sound or whatever you would like to be substituted instead (be sensible, please)! "
    ; if sharp
        then recA "x.wav" longerK
        else if (compare longerK 3.0 == GT)
               then recA "x.wav" longerK
               else recA "x.wav" 3.0
    ; putStrLn "The file is recorded and now will be automatically processed. You will be notificated with the text message in the terminal about the creation of the needed file. Please, wait a little. "
    ; if actsctrl == "-1"
        then do
          _ <- readProcessWithExitCode (fromJust (showE "sox")) ["x.wav", "_x.wav", "noisered", "nx0.wav.b.prof"] ""
          return ()
        else renameFile "x.wav" "_x.wav"
    ; norm "_x.wav"
    ; lim0 <- durationA "8_x.wav"
    ; putStrLn ""
    ; putStrLn "If you specified as a first command line argument one of the numbers below the program behaves as follows: "
    ; putStrLn "-1 -> the program does not reduce noise, it only resamples the audio to the needed 22050 Hz and adjusts the amplitude;"
    ; putStrLn "0 -> after the noise reduction the program only resample the audio to the needed 22050 Hz and adjusts the amlitude; "
    ; putStrLn "1 -> after the noise reduction the program additionally to the 0-processing truncates the silence from the beginning and end of the audio to the level given by the second command line parameter; "
    ; putStrLn "2 -> after the noise reduction the program additionally to the 1-processing applies a double band-reject filter to the audio (SoX \"sinc\" effect); "
    ; putStrLn "3 -> after the noise reduction the program additionally to the 2-processing applies fade-in and fade-out effects to the audio; "
    ; putStrLn "_ -> is the same as 3. "
    ; putStrLn ""
    ; putStrLn "If you specified as a second command line argument one of the numbers below the program behaves as follows: "
    ; putStrLn "0 -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.01; "
    ; putStrLn "1 -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.02; "
    ; putStrLn "2 -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.04; "
    ; putStrLn "3 -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.08; "
    ; putStrLn "_ -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.04; "
    ; putStrLn ""
    ; let noiseMax = getBFst' (2::Int, V.fromList [("0", 0::Int), ("1", 1::Int), ("2", 2::Int), ("3", 3::Int)]) noiseLim
    ; produceSound3 (actsctrl, noiseLim) (file, file1) soundUkr (noiseMax, duration0) lim0
    ; cleanTemp }

-- | Function 'showCoef' is used to represent the duration of the sound file.
showCoef :: String -> String
showCoef xs | any (== '.') xs =
  let (ts, us) = break (== '.') xs in let ws = showFFloat (Just 6) ((fromIntegral (read (take 6 . drop 1 $ us)::Int) + 1.0) / 1000000.0) $ show 0 in let result = ts ++ drop 1 ws in result
            | otherwise = xs

-- | Function 'beginProcessing' is used to catch the variant where the sound is fully cut by the SoX because the sound was created in inappropriate time.
-- It returns the process to the beginning of the sound recording. For the meaning of the tuple of @Sring@ parameters, refer to 
-- 'produceSound' documentation. The first @FilePath@ in the tuple of @FilePath@ parameters is a name of the sound file in @mmsyn6ukr@ package. The second one is the 
-- name of the resulting file to be produced in the current directory.
beginProcessing :: (FilePath, FilePath) -> String -> (String, String) -> IO ()
beginProcessing (file, file1) soundUkr (actsctrl, noiseLim) = do {
  cleanTemp
; putStr "The needed files were NOT created, because the sound was not at the moment of recording! The process will be restarted "
; putStrLn "for the sound. Please, produce a sound during the first 3 seconds (after 0.5 second delay) or specify greater ratio!"
; putStrLn $ "Listen to the \"" ++ soundUkr ++ "\" sound and note first of all its duration. "
; playA file
; putStrLn "The sound duration is: "
; duration0 <- durationA file
; putStrLn $ showCoef (showFFloat (Just 6) duration0 $ show 0)
; putStrLn ""
; putStrLn "It means that to produce more than 3 seconds of recording, you must specify at least "
; putStrLn $ "   " ++ show (3.0/duration0) ++ " as a next step ratio being prompt "
; putStrLn "   OR "
; putStrLn $ "   " ++ show (1.0/duration0) ++ " per one second but not less than the previous number."
; putStrLn $ "For example for 10 seconds record, please, specify " ++ show (10.0/duration0) ++ " as a next step ratio."
; (_, Just hout, _, _) <- createProcess (proc (fromJust . showE $ "soxi") ["-D", file]) { std_out = CreatePipe }
; x3 <- hGetContents hout
; (longerK0,sharp) <- tempS soundUkr
; let longerK = (read x3::Double)*longerK0
; putStrLn "Please, wait for 0.5 second and pronounce the sound representation for the "
; putStrLn ""
; putStrLn $ "                                                             \"" ++ (if soundUkr /= "ь" then map toUpper soundUkr else soundUkr) ++ "\""
; putStrLn ""
; putStrLn " sound or whatever you would like to be substituted instead (be sensible, please)! "
; if sharp
        then recA "x.wav" longerK
        else if (compare longerK 3.0 == GT)
               then recA "x.wav" longerK
               else recA "x.wav" 3.0
; putStrLn "The file is recorded and now will be automatically processed. You will be notificated with the text message in the terminal about the creation of the needed file. Please, wait a little. "
; if actsctrl /= "-1"
    then do
      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["x.wav", "_x.wav", "noisered", "nx0.wav.b.prof"] ""
      return ()
    else renameFile "x.wav" "_x.wav"
; norm "_x.wav"
; lim0 <- durationA "8_x.wav"
; putStrLn ""
; putStrLn "If you specified as a first command line argument one of the numbers below the program behaves as follows: "
; putStrLn "-1 -> the program does not reduce noise, it only resamples the audio to the needed 22050 Hz and adjusts the amplitude;"
; putStrLn "0 -> after the noise reduction the program only resamples the audio to the needed 22050 Hz and adjusts the amlitude; "
; putStrLn "1 -> after the noise reduction the program additionally to the 0-processing truncates the silence from the beginning and end of the audio to the level given by the second command line parameter; "
; putStrLn "2 -> after the noise reduction the program additionally to the 1-processing applies a double band-reject filter to the audio (SoX \'sinc\' effect); "
; putStrLn "3 -> after the noise reduction the program additionally to the 2-processing applies fade-in and fade-out effects to the audio; "
; putStrLn "_ -> is the same as 3. "
; putStrLn ""
; putStrLn "If you specified as a second command line argument one of the numbers below the program behaves as follows: "
; putStrLn "0 -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.01; "
; putStrLn "1 -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.02; "
; putStrLn "2 -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.04; "
; putStrLn "3 -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.08; "
; putStrLn "_ -> the maximum amplitude, starting from which the file will not be trimmed for the first command line argument greater of 1, is 0.04; "
; putStrLn ""
; let noiseMax = getBFst' (2::Int, V.fromList [("0", 0::Int), ("1", 1::Int), ("2", 2::Int), ("3", 3::Int)]) noiseLim
; produceSound3 (actsctrl, noiseLim) (file, file1) soundUkr (noiseMax, duration0) lim0
; cleanTemp }

-- | Function to get the @(Double, Bool)@ value. The @Double@ value shows in how many times you expect that your sound representation
-- will be longer than the one provided by the @mmsyn6ukr@ package. The second one specifies whether the program uses a \'sharp\' mode meaning that
-- it does not check whether the resulting duration of the recording is at least 3 seconds long, so you can specify shorter durations.
tempS :: String -> IO (Double, Bool)
tempS soundUkr = onException (do
    putStrLn ""
    putStr "IMPORTANT. Would you like to use a \'sharp\' mode for this sound representaiion? (Enter \'*\' as the first symbol in your next input to use the "
    putStr "\'sharp\' mode, in which the program does not use 3 seconds minimal limit to record the sound representation, "
    putStr "but a recording duration is no more than the one specified by your entered ratio). For not using the \'sharp\' mode, "
    putStrLn "enter your next input without the asterisk."
    putStrLn ""
    putStrLn "In how many times do you think your sound representing "
    putStrLn ""
    putStrLn $ "                     \"" ++ (if soundUkr /= "ь" then map toUpper soundUkr else soundUkr) ++ "\""
    putStrLn ""
    putStrLn "will sound longer than the recently played one? Specify your input as a Double value without \'e\' notation (with the preceding asterisk sign for the \'sharp\' mode). "
    longivityZ <- getLine
    let sharp0 = take 1 longivityZ
    case sharp0 of
      "*" -> let long = read (drop 1 longivityZ)::Double in return (long,True)
      _   -> let long = read longivityZ::Double in return (long,False)) (do
               putStrLn "Please, specify again the valid values!"
               tempS soundUkr)

-- | 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 'cleanTempN' removes all the intermediate temporary files produced during a noise profile creation in the directory where it is called from.
cleanTempN :: IO ()
cleanTempN = do
  filenames <- getDirectoryContents =<< getCurrentDirectory
  let rems = filter (\x -> head x == 'n') filenames in mapM_ removeFile rems

-- | Function 'tempeRa' is used to create a noise profile for all the recorded sounds. If you provide a 5 seconds silence as needed, the program will
-- reduce the noise in your recordings. This will create a cleaner sound. If you would like not to reduce the noise at all, then, please,
-- spcify \"-1\" as the first command line argument for the program @mmsyn7ukr@.
tempeRa :: IO ()
tempeRa = do {
    putStrLn "Now, please, be in a silence for 5 seconds so that the program can create a noise profile to remove the noise from the recording. "
    ; putStr "Otherwise, the program can remove from the recorded sound data some important parts as a noise. If you would like not to reduce "
    ; putStrLn "the noise at all, then, please, specify as the first command line argument \"-1\". "
    ; recA "nx1.wav" 0.07
    ; threadDelay 100000
    ; recA "nx2.wav" 0.07
    ; threadDelay 150000
    ; recA "nx3.wav" 0.07
    ; threadDelay 100000
    ; recA "nx4.wav" 0.07
    ; threadDelay 100000
    ; recA "nx5.wav" 0.07
    ; threadDelay 150000
    ; upperB1 <- upperBnd "nx1.wav"
    ; upperB2 <- upperBnd "nx2.wav"
    ; upperB3 <- upperBnd "nx3.wav"
    ; upperB4 <- upperBnd "nx4.wav"
    ; upperB5 <- upperBnd "nx5.wav"
    ; (ampl1,_) <- selMaxAbs "nx1.wav" (0,upperB1)
    ; (ampl2,_) <- selMaxAbs "nx2.wav" (0,upperB2)
    ; (ampl3,_) <- selMaxAbs "nx3.wav" (0,upperB3)
    ; (ampl4,_) <- selMaxAbs "nx4.wav" (0,upperB4)
    ; (ampl5,_) <- selMaxAbs "nx5.wav" (0,upperB5)
    ; let b1 = abs (read ampl1::Double)
          b2 = abs (read ampl2::Double)
          b3 = abs (read ampl3::Double)
          b4 = abs (read ampl4::Double)
          b5 = abs (read ampl5::Double)
    ; case minimum [b1,b2,b3,b4,b5] of
        b1 -> renameFile "nx1.wav" "nx0.wav"
        b2 -> renameFile "nx2.wav" "nx0.wav"
        b3 -> renameFile "nx3.wav" "nx0.wav"
        b4 -> renameFile "nx4.wav" "nx0.wav"
        _  -> renameFile "nx5.wav" "nx0.wav"
    ; noiseProfB "nx0.wav"
    ; putStrLn ""
    ; threadDelay 400000
    ; putStrLn "The noise sound profile is now created. The program can proceed further." }