-- |
-- 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 close to proper Ukrainian speech (if you pronounce sounds properly) with 
-- your own recorded voice.
--

module Main where

import System.Directory
import Control.Exception (onException)
import EndOfExe (showE)
import Data.Maybe (fromJust)
import Paths_mmsyn6ukr
import Processing_mmsyn7ukr
import System.Environment (getArgs)

-- | 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. 
-- The function uses a command line arguments. For their meaning, please, refer to README file.
-- 
main :: IO ()
main = do
  args <- getArgs
  putStrLn "     ***** CAUTION! *****"
  putStrLn ""
  putStrLn "\"The possession of great power necessarily implies great responsibility.\""
  putStrLn ""
  putStrLn "                                            (William Lamb)"
  putStrLn ""
  putStr "The program mmsyn7ukr produces the \"voice\" represented as an ordered "
  putStr "set of sounds each of which corresponds (represents) one of the "
  putStr "Ukrainian sounds so that using them together by mmsyn7h program "
  putStr "(https://hackage.haskell.org/package/mmsyn7h) can be a background "
  putStr "for sound synthesis. If you pronounce sounds as the appropriate "
  putStr "Ukrainian ones, close to proper Ukrainian speech with your own "
  putStr "voice. This program approximates your voice with a sequence "
  putStr "of recorded separate sounds with your control over the "
  putStr "duration of the sounds. They are then precessed by the SoX "
  putStr "binaries already installed in the system to produce the "
  putStr "needed sounds and then you can pronounce some Ukrainian text "
  putStr "with your recorded \"voice\" using mmsyn7h program. In-between "
  putStr "you can do some additional processing as you need. Moreover, "
  putStr "you can substitute whatever sounds you like (consider being "
  putStrLn "sensible) instead of your own voice."
  putStrLn ""
  putStr "Be aware that if somebody can get access to the sounds of "
  putStr "your voice or to the recorded speech (except you) then this "
  putStr "possibility itself creates security issues and concerns. So, "
  putStr "please, do NOT give access to such records to anybody else "
  putStrLn "except you."
  putStrLn ""
  putStr "In such a case, the program is for personal usage of every "
  putStrLn "user ONLY!"
  putStrLn ""
  putStr "Being given as an advice in such a case, run the program "
  putStr "in the empty directory with the current user permissions to write, "
  putStr "read and search and provide some proofs and evidence that nobody else "
  putStr "can even read the files in the directory. May be, it is better "
  putStr "to execute the program being in the directory located in the RAM, "
  putStr "then consequently wait until the program ends and then reboot "
  putStrLn "the computer. "
  putStrLn ""
  putStr "If the program ends earlier, you must then remove "
  putStr "(better wipe) the directory contents. No other users should "
  putStr "have access to the computer after you have begun to run the "
  putStr "program and have not deleted (or better wiped) the contents "
  putStr "of the directory. Please, be aware, that there are possibilities "
  putStr "to read sensitive information from the drives after you have "
  putStr "deleted the files in a usual way. You can use wiping for better "
  putStr "security. Besides, if somebody can get access to the memory of "
  putStr "the computer or to the directory contents where you run the "
  putStr "program or (may be) to the temporary files created by SoX or "
  putStr "to the drive where you run the program (not in the RAM, or may "
  putStr "be in it) then your voice can be stolen and / or used "
  putStr "inappropriately. Use all possible precautions and measures to "
  putStrLn "avoid the situation. "
  putStrLn ""
  putStr "Be aware also that the given by the program technology (or "
  putStr "documentation for it in any form) of the voice processing can "
  putStr "be improved so there is NO guarantees that the given technology "
  putStr "or its successors cannot be used in violating your voice identity "
  putStr "to produce from some available voice records the voice for the "
  putStr "inappropriate usage. Therefore, better is to proove your identity not "
  putStr "only with the solely voice itself but with some additional "
  putStrLn "independent sources and measures. "
  putStrLn ""
  putStr "The author of the program accordingly to the LICENSE (MIT) does not "
  putStr "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"]
  let a0 = concat . take 1 $ args
      a1 = concat . drop 1 . take 2 $ args
  mapM_ (produceSound (a0, a1)) paths
  silenceFs <- mapM makeAbsolute ["-.wav", "0.wav", "1.wav"]
  let pairs = zip copiedFs silenceFs
  mapM_ (\(x, y) -> copyFile x y) pairs
  putStrLn ""
  putStrLn "Your voice sound files are now created in the current directory! Use in a secure way! Remember thu initial CAUTION! "
  putStrLn ""