-- |
-- Module      :  MMSyn7h
-- Copyright   :  (c) OleksandrZhabenko 2019-2020
-- License     :  MIT
--
-- Maintainer  :  olexandr543@yahoo.com
--
-- An additional program that is used with the mmsyn7ukr executable 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 MMSyn7h where

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, listDirectory, getCurrentDirectory)
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 Data.List (isSuffixOf)
import CaseBi (getBFst')
import System.Info (os)
import MMSyn7s (show7s)

-- | Function that proposes and creates if accepted the sound record with the new \"voice\". Besides it can play the newly created file once and can delete 
-- the sound files in the current directory. If you specify the second command line argument \"s\" and then a list of @String@ represented the Ukrainian sounds, 
-- then the program will use only these sounds representations additionally to the default ones \"-.wav\", \"0.wav\" and \"1.wav\".
main7h :: IO ()
main7h = bracketOnError (do
  dir <- getCurrentDirectory
  putStrLn "You are now in the directory: "
  putStrLn $ show dir
  putStrLn ""
  putStrLn "You could specify the control parameters for the output speech file as the first command line argument to the running program mmsyn7h! "
  putStrLn "See https://hackage.haskell.org/package/mmsyn6ukr-0.6.2.0/docs/UkrainianLControl.html#v:genControl for more information."
  putStr "You could specify e. g. \"o9-1\" or \"o5-1\" (and the most compressed audio in the .ogg format will be produced) or other option. "
  putStrLn "If you have not specified the parameters and now would like to, please, terminate the running program and execute it again with the proper command line arguments. "
  args <- getArgs
  putStrLn "And now, 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
            let arg = take 1 args
            if (not . null . drop 2 $ args) && ((concat . drop 1 . take 2 $ args) == "s")
              then do
                putStrLn ""
                putStr "The resulting file will be played just after it is created by the program. To remove all the created sound files from the directory, "
                putStrLn "please, specify now the first character in the input as \"0\". Otherwise, the program will not remove any records (if they are not overwritten). "
                putStrLn ""
                putStrLn "Now enter the Ukrainian text."
                putStrLn ""
                xs <- getContents
                if take 1 xs == "0" then do
                  let ys = take (nSymbols (if null arg then [] else fst . genControl . head $ arg)) (drop 1 xs) in
                    withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFileList (convertToProperUkrainian ys, show7s . unwords . drop 2 $ args))
                  putStrLn "The .raw file was created by the program. It will be processed further. "
                  let ts = fromJust (showE "sox") in do
                    let ws = snd . genControl . concat $ arg
                    _ <- readProcessWithExitCode ts ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw",
                           fst ws, nameSF ++ snd ws] ""
                    removeFile $ nameSF ++ ".raw"
                    if take 5 os == "mingw"
                      then do
                        _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] ""
                        cleanCreatedSoundFs
                      else if isJust . showE $ "play"
                             then do
                               _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] ""
                               cleanCreatedSoundFs
                             else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again."
                else do
                  let ws = snd . genControl . concat $ arg
                  let ys = take (nSymbols (if null arg then [] else fst . genControl . head $ arg)) xs in
                    withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFileList (convertToProperUkrainian ys, show7s . unwords . drop 2 $ args))
                  putStrLn "The .raw file was created by the program. It will be processed further. "
                  let ts = fromJust (showE "sox") in do
                    _ <- readProcessWithExitCode ts (case fst ws of
                           "" -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", nameSF ++ snd ws]
                           _  -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", fst ws, nameSF ++ snd ws]) ""
                    removeFile $ nameSF ++ ".raw"
                    if take 5 os == "mingw"
                      then do
                        _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] ""
                        cleanCreatedSoundFs
                      else if isJust . showE $ "play"
                             then do
                               _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] ""
                               cleanCreatedSoundFs
                             else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again."
              else do
                putStrLn ""
                putStr "The resulting file will be played just after it is created by the program. To remove all the created sound files from the directory, "
                putStrLn "please, specify now the first character in the input as \"0\". Otherwise, the program will not remove any records (if they are not overwritten). "
                putStrLn ""
                putStrLn "Now enter the Ukrainian text."
                putStrLn ""
                xs <- getContents
                if take 1 xs == "0" then do
                  let ys = take (nSymbols (if null arg then [] else fst . genControl . head $ arg)) (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
                    let ws = snd . genControl . concat $ arg
                    _ <- readProcessWithExitCode ts ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw",
                           fst ws, nameSF ++ snd ws] ""
                    removeFile $ nameSF ++ ".raw"
                    if take 5 os == "mingw"
                      then do
                        _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] ""
                        cleanCreatedSoundFs
                      else if isJust . showE $ "play"
                             then do
                               _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] ""
                               cleanCreatedSoundFs
                             else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again."
                else do
                  let ws = snd . genControl . concat $ arg
                  let ys = take (nSymbols (if null arg then [] else fst . genControl . head $ arg)) 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 (case fst ws of
                           "" -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", nameSF ++ snd ws]
                           _  -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", fst ws, nameSF ++ snd ws]) ""
                    removeFile $ nameSF ++ ".raw"
                    if take 5 os == "mingw"
                      then do
                        _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] ""
                        cleanCreatedSoundFs
                      else if isJust . showE $ "play"
                             then do
                               _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] ""
                               cleanCreatedSoundFs
                             else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again.")

-- | 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 ()

-- | The function that actually produces a .raw file. The mapping table is given in the @Map.txt@ file, but the sound duration differs. 
-- The @[String]@ parameter is a sorted list of Ukrainian sounds to be used (for example, it can be obtained with @mmsyn7s@ executable from the same name package).
appendS16LEFileList :: (V.Vector String, [String]) -> Handle -> IO ()
appendS16LEFileList (xs, yss) hdl | not (V.null xs) && not (null yss) =
  do
    let intrm = map (getBFst' ("0.wav", 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"])) yss
    dataList <- (V.mapM takeData . V.fromList) (["-.wav", "0.wav", "1.wav"] ++ intrm)
    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)] ++ zip yss [3..]) u
            else error "File is not closed!"
        else error "Data sound file is not read!") xs
    hClose hdl
                                  | otherwise = return ()

-- | 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