-- |
-- Module      :  Main
-- Copyright   :  (c) OleksandrZhabenko 2019
-- License     :  MIT
--
-- Maintainer  :  olexandr543@yahoo.com
--
-- An additional program that is used internally in the mmsyn7ukr package as a sound creator with the voice
-- given by the files in the current directory. It is very similar to the Main.hs of the mmsyn6ukr package.

--

module Main where

import Control.Monad (void)
import Data.Char (isSpace, isControl)
import Data.Maybe (isJust,fromJust)
import System.IO
import System.Environment (getArgs)
import System.Process (readProcessWithExitCode)
import System.Directory (removeFile)
import Control.Exception (bracketOnError)
import EndOfExe (showE)
import Melodics.Ukrainian (convertToProperUkrainian, takeData)
import UkrainianLControl
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy as B
import CaseBi (getBFst')

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

-- | The main function. It calls 'main7h'.
main :: IO ()
main = do
  putStrLn "Next file can be now voiced by your \"voice\"."
  main7h

-- | 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.
main7h :: IO ()
main7h = bracketOnError (do
  putStrLn "Please, specify the arguments to control the output speech file! "
  putStrLn "See https://hackage.haskell.org/package/mmsyn6ukr-0.6.1.0/docs/UkrainianLControl.html#v:genControl for more information."
  putStrLn "You can specify e. g. \"o9-1\" or \"o5-1\" or other option."
  arg <- getArgs
  let args = take 1 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 
            putStrLn ""
            putStrLn "If you would like to play the resulting file just after it is created by the program, please, begin the input from the symbol \'1\'. "
            putStrLn "In all other cases the file will not be played after creation."
            xs <- getContents
            if take 1 xs == "1" then do
              let ys = take (nSymbols (let zs = take 1 args in if null zs then [] else fst . genControl . head $ zs)) (drop 1 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"
                if isJust . showE $ "play"
                  then void (readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ (snd . snd . genControl . concat $ args)] "")
                  else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again."
            else do
              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")
                

-- | The function that actually produces a .raw file. The mapping table is given in the @Map.txt@ file, but the sound duration differs.
appendS16LEFile ::  V.Vector String -> Handle -> IO ()
appendS16LEFile xs hdl | not (V.null xs) = 
  do
    dataList <- (V.mapM takeData . V.fromList) ["-.wav", "0.wav", "1.wav", "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"]
    V.mapM_ (\u -> 
      if V.all (\z -> B.length z > 0) dataList 
        then let rs =  tail . dropWhile (/= ' ') . takeWhile (/= '}') . show $ hdl in do
          hClose hdl
          closedHdl <- hIsClosed hdl
          if closedHdl 
            then B.appendFile rs $ dataList V.! getBFst' (0, V.fromList [("-", 0), ("0", 1), ("1", 2), ("а", 3), ("б", 4), 
                     ("в", 5), ("г", 6), ("д", 7), ("дж", 8), ("дз", 9), ("е", 10), ("ж", 11), ("з", 12), ("и", 13), 
                        ("й", 14), ("к", 15), ("л", 16), ("м", 17), ("н", 18), ("о", 19), ("п", 20), ("р", 21), 
                          ("с", 22), ("сь", 23), ("т", 24), ("у", 25), ("ф", 26), ("х", 27), ("ц", 28), ("ць", 29), ("ч", 30), 
                            ("ш", 31), ("ь", 32), ("і", 33), ("ґ", 34)]) u
            else error "File is not closed!"
        else error "Data sound file is not read!") xs
    hClose hdl
                       | otherwise = return ()