-- |
-- Module      :  Processing_mmsyn7ukr
-- 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 sounds properly) with 
-- your own recorded voice.
--

module Processing_mmsyn7ukr where

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 control 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 'alterVabE' functions must be applied (that is specified 
-- by the first @String@ parameter). 
produceSound :: (String, String) -> FilePath -> IO ()
produceSound (actsctrl, noiseLim) file  = 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
; 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!"
; playA file
; putStrLn "The sound duration is: "
; produceSound2 (file, file1) (actsctrl, noiseLim) soundUkr
; return () }


-- | 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
    "0" ->
      do
          lim1 <- durationA "_8x.wav"
          if lim1 <= 0.0
            then beginProcessing file file1 soundUkr (actsctrl, noiseLim)
            else do
              resampleA "_8x.wav" (22050::Int)
              norm "3_8x.wav"
              volS2 "83_8x.wav" file
              renameFile "8.3_8x.wav" file1
    "1" ->
      do
          alterVadB "_8x.wav" lim0 noiseMax (duration0*0.1)
          lim1 <- durationA "_8x.wav"
          if lim1 <= 0.0
            then beginProcessing file file1 soundUkr (actsctrl, noiseLim)
            else do
              alterVadE "_8x.wav" lim1 noiseMax (duration0*0.1)
              resampleA "_8x.wav" (22050::Int)
              norm "3_8x.wav"
              volS2 "83_8x.wav" file
              renameFile "8.3_8x.wav" file1
    "2" ->
      do
          alterVadB "_8x.wav" lim0 noiseMax (duration0*0.1)
          lim1 <- durationA "_8x.wav"
          if lim1 <= 0.0
            then beginProcessing file file1 soundUkr (actsctrl, noiseLim)
            else do
              alterVadE "_8x.wav" lim1 noiseMax (duration0*0.1)
              sincA "_8x.wav"
              resampleA "4._8x.wav" (22050::Int)
              norm "34._8x.wav"
              volS2 "834._8x.wav" file
              renameFile "8.34._8x.wav" file1
    _ ->
      do
          alterVadB "_8x.wav" lim0 noiseMax (duration0*0.1)
          lim1 <- durationA "_8x.wav"
          if lim1 <= 0.0
            then beginProcessing file file1 soundUkr (actsctrl, noiseLim)
            else do
              alterVadE "_8x.wav" lim1 noiseMax (duration0*0.1)
              sincA "_8x.wav"
              resampleA "4._8x.wav" (22050::Int)
              quarterSinFade "34._8x.wav"
              norm "434._8x.wav"
              volS2 "8434._8x.wav" file
              renameFile "8.434._8x.wav" 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
    ; longerK0 <- tempS soundUkr
    ; (_, Just hout, _, _) <- createProcess (proc (fromJust . showE $ "soxi") ["-D", file]) { std_out = CreatePipe }
    ; x3 <- hGetContents hout
    ; putStrLn $ showFFloat Nothing 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/(7*duration0)) ++ " as a next step ratio being prompt "
    ; putStrLn "    ;  OR "
    ; putStrLn $ "    ;  " ++ show (1.0/(7*duration0)) ++ " per one second but not less than the previous number."
    ; putStrLn $ "For example for 10 seconds record, please, specify " ++ show (10.0/(7*duration0)) ++ " as a next step ratio."
    ; 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 (compare (7*longerK) 3.0 == LT)
       then recA "x.wav" (7*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. "
    ; norm "x.wav"
    ; noiseProfB "8x.wav"
    ; noiseReduceB "8x.wav"
    ; lim0 <- durationA "_8x.wav"
    ; putStrLn ""
    ; putStrLn "If you specified as a first command line argument the following the program behaves: "
    ; 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 the following the program behaves: "
    ; 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 '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.
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 $ showFFloat Nothing 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/(7*duration0)) ++ " as a next step ratio being prompt "
; putStrLn ";  OR "
; putStrLn $ ";  " ++ show (1.0/(7*duration0)) ++ " per one second but not less than the previous number."
; putStrLn $ "For example for 10 seconds record, please, specify " ++ show (10.0/(7*duration0)) ++ " as a next step ratio."
; longerK0 <- tempS soundUkr
; (_, Just hout, _, _) <- createProcess (proc (fromJust . showE $ "soxi") ["-D", file]) { std_out = CreatePipe }
; x3 <- hGetContents hout
; 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 (compare (7*longerK) 3.0 == LT)
    then recA "x.wav" (7*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. "
; norm "x.wav"
; noiseProfB "8x.wav"
; noiseReduceB "8x.wav"
; lim0 <- durationA "_8x.wav"
; putStrLn ""
; putStrLn "If you specified as a first command line argument the following the program behaves: "
; 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 the following the program behaves: "
; 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@ value, which shows in how many times you expect that your sound representation will be longer than the one provided by the @mmsyn6ukr@ package. 
tempS :: String -> IO Double
tempS soundUkr = onException (do
    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 as a Double value without \"e\" notation. "
    longivityY <- getLine
    let long = read longivityY::Double in return long) (do
      putStrLn "Please, specify the value of the Double type!"
      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