-- |
-- 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 (bracketOnError, onException)
import EndOfExe (showE)
import Data.Maybe (fromJust)
import Data.Char
import Data.List (isSuffixOf)
import qualified Data.Vector as V
import System.Process
import System.IO
import SoXBasics
import Melodics.Ukrainian (appendS16LEFile, convertToProperUkrainian)
import UkrainianLControl
import CaseBi (getBFst')

-- | Function that being given a path to the installed by the @mmsyn6ukr@ package file produces the corresponding analogous sound with your created 
-- voicing.
produceSound :: FilePath -> IO ()
produceSound file = let file1 = drop (length file - 5) file in do
  let 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:"
  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"
  alterVadB "_8x.wav" lim0
  lim1 <- durationA "7_8x.wav"
  if lim1 <= 0.0
    then beginProcessing file file1 soundUkr
    else do 
      alterVadE "7_8x.wav" lim1
      sincA "67_8x.wav"
      resampleA "4.67_8x.wav" (22050::Int)
      quarterSinFade "34.67_8x.wav"
      norm "434.67_8x.wav"
      volS2 "8434.67_8x.wav" file
      renameFile "8.434.67_8x.wav" file1
      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.
beginProcessing :: FilePath -> FilePath -> String -> IO ()
beginProcessing file file1 soundUkr = 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"
  alterVadB "_8x.wav" lim0
  lim1 <- durationA "7_8x.wav"
  if lim1 <= 0.0
    then beginProcessing file file1 soundUkr
    else do 
      alterVadE "7_8x.wav" lim1
      sincA "67_8x.wav"
      resampleA "4.67_8x.wav" (22050::Int)
      quarterSinFade "34.67_8x.wav"
      norm "434.67_8x.wav"
      volS2 "8434.67_8x.wav" file
      renameFile "8.434.67_8x.wav" file1
      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 that removes all the sounds with ".raw", ".wav", ".ogg", ".flac" extensions in the current directory. It is used for 
-- the security reasons.
cleanCreatedSoundFs :: IO ()
cleanCreatedSoundFs = do
  dirCs <- listDirectory "."
  let remFs = concatMap (\ys -> filter (\zs -> ys `isSuffixOf` zs) dirCs) [".raw", ".wav", ".ogg", ".flac"] in mapM_ removeFile remFs

-- | Function that repeatedly proposes and creates if accepted the sound records with the new \"voice\". Besides it can play the newly created file once.
createAndPlayFs :: IO ()
createAndPlayFs = do 
  putStrLn "Next file can be now voiced by your \"voice\". If you would like to run a new round and create a new speech, enter \"y\" as  text input now!"
  putStrLn "Otherwise, the program will end and remove all your sound files in the current directory created with your voice during the program execution time."
  choice <- getLine
  if take 1 choice == "y"
    then do
      main6Ukr
      createAndPlayFs
    else return ()
  
-- | Function that proposes and creates if accepted the sound record with the new \"voice\". Besides it can play the newly created file once. It is used in the
-- 'createAndPlayFs' function internally and recursively.
main6Ukr :: IO ()
main6Ukr = bracketOnError (do
  putStrLn "Please, specify the arguments to control the output speech file! "
  putStrLn "See https://hackage.haskell.org/package/mmsyn6ukr-0.6.0.0/docs/UkrainianLControl.html#v:genControl for more information."
  putStrLn "You can specify e. g. \"o9-1\" or \"o5-1\" or other options."
  arg <- getLine
  let args = take 1 . words $ arg in do 
    putStrLn "Please, specify the name of the resulting sound file! Please, do NOT use '}' character and space or control characters!"
    nameOfSoundFile <- getLine
    let nameSF = filter (\x -> not (isSpace x) && not (isControl x) && x /= '}') nameOfSoundFile in
      return (args, nameSF)) (\(args, nameSF) -> do
        putStr $ "Notice, there was (may be) CmdLineArgument exception. To avoid it, please, specify the command line argument (if needed) in the form \"ABC\""
        putStrLn $ " where A is either a letter \'f\', \'o\', \'w\' or a digit and B and C are both digits! The exception (may be) arose from the command line arguments " 
          ++ show args ++ " for the file: " ++ show nameSF ++ ". Please, check also whether the SoX was installed with the support for needed codec.") (\(args, nameSF) -> do 
            xs <- getContents
            let ys = take (nSymbols (let zs = take 1 args in if null zs then [] else fst . genControl . head $ zs)) xs in 
              withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFile (convertToProperUkrainian ys))
            putStrLn "The .raw file was created by the program. It will be processed further. "
            let ts = fromJust (showE "sox") in do
              _ <- readProcessWithExitCode ts ["r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", 
                fst . snd . genControl . concat $ args, nameSF ++ (snd . snd . genControl . concat $ args)] ""
              removeFile $ nameSF ++ ".raw"
              putStrLn "Would you like to play the resulting file now?"
              pls <- getLine
              if take 1 pls == "y" || take 1 pls == "Y" 
                then playA $ nameSF ++ (snd . snd . genControl . concat $ args)
                else return ())