-- |
-- Module      :  Main
-- Copyright   :  (c) OleksandrZhabenko 2019-2020
-- License     :  MIT
-- Maintainer  :  olexandr543@yahoo.com
--
-- A program and a library that can be used as a musical instrument synthesizer or for Ukrainian speech synthesis 
-- especially for poets, translators and writers. 
--

module Main where

import Data.Char (isSpace, isControl)
import Data.Maybe (isJust,fromJust)
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import System.Environment (getArgs)
import System.Process (callProcess)
import System.Directory (removeFile,findExecutable)
import Control.Exception (bracketOnError)
import EndOfExe (showE)
import Melodics.Ukrainian (appendS16LEFile, convertToProperUkrainian)
import UkrainianLControl

{-
-- Inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html
-}

-- | The function creates a raw PCM sound file with bitrate 22050 Hz 1 mono channel 16-bit signed-integer encoding 
-- and tries to automatically convert it to the .wav, .ogg, or .flac file with the same parameters specified by the first command line argument
-- (for more details see: 'genControl' function) using the system binary SoX. 
-- If it is not installed properly, the program makes ending informational message for the user. 
-- 
-- Command line argument is described in more details in the documentation for the 'Melodics.Ukrainian.nSymbols' function. 
-- 
-- * Notification.
-- 
-- Please, notice that successful usage of the SoX installed in the system at the moment of running the @mmsyn6ukr@ can lead to approximately doubling 
-- (in the most space consuming variant) the size of used space in the storage for the resulting files while being processed because it adds a header 
-- to the .raw file and writes down additionally the raw data to form a .wav file. Afterwards, it deletes the .raw file, so space is used finally in the 
-- more efficient manner. 
-- 
-- Also notice that the size of the largest data file representing a symbol or their combination is 6792 bytes (with 44-byte header included). So, if you 
-- expect to create sounding for @n@ symbols of the Ukrainian text, provide at least @2 * (6792 - 44) * n + 44 = 13496 * n + 44@ (bytes) of the additional 
-- space in the storage (in reality it can occupy much less because other data files are less in size). Afterwards, the program deletes the .raw file (this 
-- will approximately halve the occupied space by the resulting file) and you can manually compress the .wav file (e. g. FLAC compression with the best ratio 
-- gives approximately 0.53 of the original size. Therefore, the resulting file for the @mmsyn6ukr@ executable run prior to such operations without command 
-- line arguments is expected to be less than about @10^7@ bytes that is about 100 MB (for 31416 symbols Ukrainian text)). 
-- 
-- The best comression ratio is with the .ogg files, but they lose some quality so be careful if you need it.
main :: IO ()
main = bracketOnError (do
  args <- getArgs
  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
  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. If there is SoX installed then it will run further. "
         let ts = showE "sox" in if isJust ts
                      then do
                             if null args
                               then do
                                  callProcess (fromJust . unsafePerformIO . findExecutable . fromJust $ ts) ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", nameSF ++ ".wav"]
                                  removeFile $ nameSF ++ ".raw"
                               else do
                                  let ws = snd . genControl . head . take 1 $ args in callProcess (fromJust . unsafePerformIO . findExecutable . fromJust $ ts)
                                    ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", fst ws, nameSF ++ snd ws]
                                  removeFile $ nameSF ++ ".raw"
                      else do
                         putStr "You have a resulting file in a raw PCM format with bitrate 22050 Hz and 1 channel (mono) in the .raw format. "
                         putStr "You can further process it by yourself manually, otherwise, please, install FFMpeg or LibAV executables in the directory mentioned in the variable PATH"
                         putStrLn " and then run: "
                         putStrLn "\"name_of_FFMpeg_or_LibAV_executable\" -f s16le -acodec pcm_s16le -ac 1 -ar 22050 -i \"name_Of_the_sound_file\" \"the_same_name_without_.raw_ending_and_with_.wav_ending\""
                         putStrLn ""
                         putStrLn "OR you can install SoX executable in the directory mentioned in the variable PATH and then run: "
                         putStrLn "\"Path_to_the_SoX_executable\" -b16 -r22050 -c1 -e signed-integer -L \"name_of_the_file_in_raw_format_with_new._prefix\" \"name_of_the_file_in_raw_format_with_new._prefix\" in the terminal.")