-- |
-- Module      :  Main
-- 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 Main where

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 Paths_mmsyn6ukr
import UkrainianLControl
import CaseBi (getBFst')

-- | Function responds for general program execution. It starts with Caution to be responsible for usage and to 
-- use it personally. Then the program guides you through the creating and using your Ukrainian \"voice\". 
-- Please, use it carefully. After the execution the program if terminated naturally without interruption 
-- removes (cleans) all the created sound files in the current directory for security reasons. If it terminates 
-- by interruption or in general it is a good practice to remove the current directory sound files manually.
-- 
main :: IO ()
main = do
  putStrLn "        ***** CAUTION! *****"
  putStrLn ""
  putStrLn "With great power comes great responsibility"
  putStrLn ""
  putStrLn "The program mmsyn7ukr produces the approximately Ukrainian speech with your own recorded voice."
  putStr " It approximates your voice with a sequence of recorded separate sounds with your control over "
  putStr "the duration of the sounds. They are then precessed by the SoX binaries in the system"
  putStrLn " to produce the needed sounds and then you can spell some Ukrainian text with your recorded \"voice\"."
  putStr "Be aware that if somebody can get access to the sounds of your voice or to the recorded speech except you "
  putStrLn "then this possibility creates security issues and concerns. So, please, do NOT give access to the records to anybody else except you."
  putStrLn ""
  putStrLn "The program is for personal usage of every user ONLY!"
  putStrLn ""
  putStr "As an advice, run the program in the empty writable, readable and seekable diractory only for the current user -- better in the RAM, "
  putStr "wait until the program ends and then reboot the computer. If the program ends earlier, you must then remove (better wipe) the directory "
  putStr "contents. No other users should have access to the computer "
  putStr "after you have begun to run the program and have not deleted (or better wiped) the contents of the directory."
  putStr " Please, be aware, that there are possibilities to read sensitive information from the drives after you have "
  putStr "deleted the files in a usual way. You can use wiping for better security. Besides, if somebody can get access "
  putStr "to the memory of the computer or to the directory contents where you run the program or (may be) to the temporary "
  putStr "files created by SoX or to the drive where you run the program (not in the RAM, or may be in it) "
  putStr "then your \"voice\" can be stolen and / or used inappropriately. Use all possible precautions and measures to avoid the "
  putStrLn "situation."
  putStr "Be aware also that the given by the program technology (or documentation for it in any form) of the voice processing can be improved so there is NO guarantees "
  putStr "that the given technology or its successors cannot be used in violating your voice identity to produce from some voice records available "
  putStr "the \"voice\" for the inappropriate or illegal usage. So, better is to proove your identity not only with the solely voice itself but "
  putStrLn "with some additional independent sources and measures. "
  putStr "The author of the program accordingly to the LICENSE (MIT) does not response for any possible issues, but by this notification tries to "
  putStrLn "intent you to be aware of some possible issues."
  putStrLn ""
  onException (do
    let eS = fromJust (showE "sox")
        eSi = fromJust (showE "soxi")
        eSp = fromJust (showE "play")
        eSr = fromJust (showE "rec")
    return ()) (error "SoX is not properly installed in your system. Please, install it properly and the run the program again! ")
  paths <- mapM getDataFileName ["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"]
  copiedFs <- mapM getDataFileName ["-.wav", "0.wav", "1.wav"]
  mapM_ produceSound paths
  currD <- getCurrentDirectory
  mapM_ (flip copyFile currD) copiedFs
  putStrLn ""
  putStrLn "Your voice sound files are now created in the current directory! Use in a secure way! Remember thu initial CAUTION! "
  putStrLn ""
  createAndPlayFs
  cleanTemp
  cleanCreatedSoundFs
  return ()

-- | 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
  putStrLn $ "Listen to the \"" ++ soundUkr ++ "\" sound and note first of all its duration. "
  playA file
  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, now spell the sound representation of the " ++ soundUkr ++ " sound! "
  recA "x.wav" (7*longerK)
  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"
  alterVadE "7_8x.wav" lim1
  sincA "67_8x.wav"
  resampleA "4.67_8x.wav" (22050::Int)
  quarterSinFade "34.67_8x.wav"
  volS2 "434.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 " ++ soundUkr ++ " will sound longer than the recently played one? Specify as a Double value without \"e\" notation. "
    longivityY <- getLine
    let longS = take 5 longivityY in let long = read longS::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 ())