-- |
-- Module      :  MMSyn7h
-- Copyright   :  (c) OleksandrZhabenko 2019-2020
-- License     :  MIT
-- Stability   :  Experimental
-- 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.

--

{-# OPTIONS_GHC -threaded #-}

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,onException)
import EndOfExe (showE)
import Melodics.Ukrainian (convertToProperUkrainian, takeData)
import UkrainianLControl
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as BS
import Data.List (isSuffixOf)
import CaseBi (getBFst')
import System.Info (os)
import MMSyn6Ukr.Show7s (show7s)
import Control.Exception.FinalException

-- | Function that proposes and creates if accepted the sound record with the new \"voice\". It plays the newly created file once. Then it can delete
-- the sound files in the current directory while being executed if you specify when prompted the text that starts with \"y\".
-- If you enter as a first command line argument \"-h\",
-- then the program only prints informational message. If you specify as a first command line argument \"-v\", then
-- the program only prints its version number. If you specify something else, the first command line argument is being treated as
-- a name for the resulting file voiced. If you specify further command line arguments
-- as a Ukrainian text, that contains only those sounds, which sound representations are in the current directory (you can create them by e. g. @mmsyn7ukr@ and @mmsyn7l@
-- programs in the same name packages), then the program will use only these sounds representations additionally to the default ones \"-.wav\",
-- \"0.wav\" and \"1.wav\" and produce the sounding for the text.
main7h :: IO ()
main7h :: IO ()
main7h = do
  [String]
args <- IO [String]
getArgs
  String -> IO ()
putStr String
"If you do not use the command line parameters \"-h\" or \"-v\", then you must have specified the file name for the resulting sound recording "
  String -> IO ()
putStrLn String
"(do NOT use '}' character and space or control characters!). "
  case ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args) of
    String
""   -> FinalException -> IO ()
catchEnd FinalException
NotFileNameGiven
    String
"-h" -> do
          String -> IO ()
putStrLn String
"SYNOPSIS: "
          String -> IO ()
putStrLn String
"mmsyn7h fileName [control parameter (see: genControl from mmsyn6ukr package) [a Ukrainian text being one line to be voiced (if any specified)]]  OR"
          String -> IO ()
putStrLn String
"mmsyn7h -h    OR"
          String -> IO ()
putStrLn String
"mmsyn7h -v"
          String -> IO ()
putStr String
"If \"-h\" is specified, then you will see this message. If \"-v\" is specified, then you will see the version of the package mmsyn7h. "
          String -> IO ()
putStrLn String
"If something else (not null) is specified then the program runs further. "
    String
"-v" -> String -> IO ()
putStrLn String
"mmsyn7h version: 0.8.0.0"
    String
nameOfSoundFile    -> IO ([String], String)
-> (([String], String) -> IO ())
-> (([String], String) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (do
          IO ()
giveInfo
          let nameSF :: String
nameSF = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Bool -> Bool
not (Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isControl Char
x) Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') String
nameOfSoundFile
          String -> IO ()
putStrLn String
""
          ([String], String) -> IO ([String], String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
args, String
nameSF)) (\([String]
args, String
nameSF) -> do
            String -> IO ()
putStr String
"Notice, there was (may be) CmdLineArgument exception. To avoid it, please, specify the second command line argument (if needed) in the form \"ABC\""
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" 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 "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
args String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for the file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Please, check also whether the SoX was installed with the support for needed codec.")
              (\([String]
args, String
nameSF) -> do
                let arg :: [String]
arg = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
args
                if (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> ([String] -> [String]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
args)
                  then do
                    String -> IO ()
putStrLn String
""
                    String -> IO ()
putStr String
"The resulting file will be played just after it is created by the program. "
                    String -> IO ()
putStrLn String
""
                    let xs :: String
xs = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args
                        ws :: (String, String)
ws = (String, (String, String)) -> (String, String)
forall a b. (a, b) -> b
snd ((String, (String, String)) -> (String, String))
-> ([String] -> (String, (String, String)))
-> [String]
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, (String, String))
genControl (String -> (String, (String, String)))
-> ([String] -> String) -> [String] -> (String, (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> (String, String)) -> [String] -> (String, String)
forall a b. (a -> b) -> a -> b
$ [String]
arg
                        ys :: String
ys = Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
nSymbols (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
arg then [] else (String, (String, String)) -> String
forall a b. (a, b) -> a
fst ((String, (String, String)) -> String)
-> ([String] -> (String, (String, String))) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, (String, String))
genControl (String -> (String, (String, String)))
-> ([String] -> String) -> [String] -> (String, (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
arg)) String
xs
                    String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile (String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw") IOMode
AppendMode ((Vector String, [String]) -> Handle -> IO ()
appendS16LEFileList (String -> Vector String
convertToProperUkrainian String
ys, String -> [String]
show7s String
xs))
                    String -> IO ()
putStrLn String
"The .raw file was created by the program. It will be processed further. "
                    let ts :: String
ts = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox") in do
                      (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
ts (case (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
ws of
                             String
"" -> [String
"-r22050",String
"-c1",String
"-L",String
"-esigned-integer",String
"-b16", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws]
                             String
_  -> [String
"-r22050",String
"-c1",String
"-L",String
"-esigned-integer",String
"-b16", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw", (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
ws, String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws]) String
""
                      String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw"
                      if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
5 String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw"
                        then do
                          (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"sox") [String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws, String
"-t", String
"waveaudio", String
"-d"] String
""
                          () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        else if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (String -> Maybe String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"play"
                               then do
                                 (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"play") [String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws] String
""
                                 () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                               else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
                else do
                  [String
xs, String
wws] <- (Int -> IO String) -> [Int] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO String
defineClean ([Int
0,Int
1]::[Int])
                  if String
wws String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"y" then do
                    let ys :: String
ys = Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
nSymbols (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
arg then [] else (String, (String, String)) -> String
forall a b. (a, b) -> a
fst ((String, (String, String)) -> String)
-> ([String] -> (String, (String, String))) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, (String, String))
genControl (String -> (String, (String, String)))
-> ([String] -> String) -> [String] -> (String, (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
arg)) String
xs
                    String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile (String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw") IOMode
AppendMode (Vector String -> Handle -> IO ()
appendS16LEFile (String -> Vector String
convertToProperUkrainian String
ys))
                    String -> IO ()
putStrLn String
"The .raw file was created by the program. It will be processed further. "
                    let ts :: String
ts = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox") in do
                      let ws :: (String, String)
ws = (String, (String, String)) -> (String, String)
forall a b. (a, b) -> b
snd ((String, (String, String)) -> (String, String))
-> ([String] -> (String, (String, String)))
-> [String]
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, (String, String))
genControl (String -> (String, (String, String)))
-> ([String] -> String) -> [String] -> (String, (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> (String, String)) -> [String] -> (String, String)
forall a b. (a -> b) -> a -> b
$ [String]
arg
                      (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
ts [String
"-r22050",String
"-c1",String
"-L",String
"-esigned-integer",String
"-b16", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw",
                             (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
ws, String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws] String
""
                      String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw"
                      if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
5 String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw"
                        then do
                          (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"sox") [String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws, String
"-t", String
"waveaudio", String
"-d"] String
""
                          IO ()
cleanCreatedSoundFs
                        else if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (String -> Maybe String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"play"
                               then do
                                 (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"play") [String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws] String
""
                                 IO ()
cleanCreatedSoundFs
                               else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
                  else do
                    let ws :: (String, String)
ws = (String, (String, String)) -> (String, String)
forall a b. (a, b) -> b
snd ((String, (String, String)) -> (String, String))
-> ([String] -> (String, (String, String)))
-> [String]
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, (String, String))
genControl (String -> (String, (String, String)))
-> ([String] -> String) -> [String] -> (String, (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> (String, String)) -> [String] -> (String, String)
forall a b. (a -> b) -> a -> b
$ [String]
arg
                        ys :: String
ys = Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
nSymbols (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
arg then [] else (String, (String, String)) -> String
forall a b. (a, b) -> a
fst ((String, (String, String)) -> String)
-> ([String] -> (String, (String, String))) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, (String, String))
genControl (String -> (String, (String, String)))
-> ([String] -> String) -> [String] -> (String, (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
arg)) String
xs
                    String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile (String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw") IOMode
AppendMode (Vector String -> Handle -> IO ()
appendS16LEFile (String -> Vector String
convertToProperUkrainian String
ys))
                    String -> IO ()
putStrLn String
"The .raw file was created by the program. It will be processed further. "
                    let ts :: String
ts = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox") in do
                      (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
ts (case (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
ws of
                             String
"" -> [String
"-r22050",String
"-c1",String
"-L",String
"-esigned-integer",String
"-b16", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws]
                             String
_  -> [String
"-r22050",String
"-c1",String
"-L",String
"-esigned-integer",String
"-b16", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw", (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
ws, String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws]) String
""
                      String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".raw"
                      if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
5 String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw"
                        then do
                          (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"sox") [String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws, String
"-t", String
"waveaudio", String
"-d"] String
""
                          () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        else if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (String -> Maybe String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"play"
                               then String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"play") [String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws] String
"" IO (ExitCode, String, String) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                               else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled)

-- | Used internally in the 'main7h' function.
giveInfo :: IO ()
giveInfo :: IO ()
giveInfo = do
  String
dir <- IO String
getCurrentDirectory
  String -> IO ()
putStrLn String
"You are now in the directory: "
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
dir
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"You could specify a name of the resulting file and then the control parameters for the output speech file as "
  String -> IO ()
putStrLn String
"the second command line argument to the running program mmsyn7h! "
  String -> IO ()
putStrLn String
"See https://hackage.haskell.org/package/mmsyn6ukr-0.8.0.0/docs/UkrainianLControl.html#v:genControl for more information."
  String -> IO ()
putStr String
"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. "
  String -> IO ()
putStrLn String
"If you have not specified the name and the parameters and now would like to, please, terminate the running program and execute it again with the proper command line arguments. "
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"If you specified further command line arguments as a Ukrainian text, that contains only those sounds, which sound representations are in the current directory "
  String -> IO ()
putStr String
"(you can create them by e. g. mmsyn7ukr and mmsyn7l programs in the same name packages), then the program will use only these sounds representations "
  String -> IO ()
putStrLn String
"additionally to the default ones \"-.wav\", \"0.wav\" and \"1.wav\". See further: https://hackage.haskell.org/package/mmsyn7s"
  String -> IO ()
putStrLn String
""

-- | Used internally in the 'main7h' function for specifying whether clean the current directory from the sound files.
defineClean :: Int -> IO String
defineClean :: Int -> IO String
defineClean Int
x
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = IO String -> IO String -> IO String
forall a b. IO a -> IO b -> IO a
onException (do
     String -> IO ()
putStrLn String
""
     String -> IO ()
putStr String
"The resulting file will be played just after it is created by the program. "
     String -> IO ()
putStrLn String
""
     String -> IO ()
putStrLn String
"Now enter the Ukrainian text."
     String -> IO ()
putStrLn String
""
     String
xs <- IO String
getLine
     String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
xs ) (do { String -> IO ()
putStrLn String
"The process was not successful may be because of the not valid data specified. Please, specify valid data. "
                     ; Int -> IO String
defineClean Int
0 })
  | Bool
otherwise = IO String -> IO String -> IO String
forall a b. IO a -> IO b -> IO a
onException (do
     String -> IO ()
putStr String
"Would you like to remove all the sound files created in the directory after playback? If yes, then enter here \"y\". Otherwise, "
     String -> IO ()
putStrLn String
"the files will not be removed by the program. "
     String
ys <- IO String
getLine
     let zs :: String
zs = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
ys in String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
zs )
       (do { String -> IO ()
putStr String
"The process was not successful may be because of the not valid data specified. "
           ; String -> IO ()
putStrLn String
"Please, specify valid data. "
           ; Int -> IO String
defineClean Int
1 })

-- | 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 :: Vector String -> Handle -> IO ()
appendS16LEFile Vector String
xs Handle
hdl | Bool -> Bool
not (Vector String -> Bool
forall a. Vector a -> Bool
V.null Vector String
xs) =
  do
    Vector ByteString
dataList <- (String -> IO ByteString)
-> Vector String -> IO (Vector ByteString)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM String -> IO ByteString
takeData ([String] -> Vector String
forall a. [a] -> Vector a
V.fromList [String
"-.wav", String
"0.wav", String
"1.wav", String
"A.wav", String
"B.wav", String
"C.wav", String
"D.wav", String
"E.wav", String
"F.wav", String
"G.wav", String
"H.wav",
        String
"I.wav", String
"J.wav", String
"K.wav", String
"L.wav", String
"M.wav", String
"N.wav", String
"O.wav", String
"P.wav", String
"Q.wav", String
"R.wav",
          String
"S.wav", String
"T.wav", String
"U.wav", String
"V.wav", String
"W.wav", String
"X.wav", String
"Y.wav", String
"Z.wav", String
"a.wav", String
"b.wav", String
"c.wav",
            String
"d.wav", String
"e.wav", String
"f.wav"])
    (String -> IO ()) -> Vector String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (\String
u ->
      if (ByteString -> Bool) -> Vector ByteString -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all (\ByteString
z -> ByteString -> Int
BS.length ByteString
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Vector ByteString
dataList
        then let rs :: String
rs =  String -> String
forall a. [a] -> [a]
tail (String -> String) -> (Handle -> String) -> Handle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (String -> String) -> (Handle -> String) -> Handle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') (String -> String) -> (Handle -> String) -> Handle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String
forall a. Show a => a -> String
show (Handle -> String) -> Handle -> String
forall a b. (a -> b) -> a -> b
$ Handle
hdl in do
          Handle -> IO ()
hClose Handle
hdl
          Bool
closedHdl <- Handle -> IO Bool
hIsClosed Handle
hdl
          if Bool
closedHdl
            then String -> ByteString -> IO ()
BS.appendFile String
rs (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector ByteString
dataList Vector ByteString -> Int -> ByteString
forall a. Vector a -> Int -> a
V.! (Int, Vector (String, Int)) -> String -> Int
forall a b. Ord a => (b, Vector (a, b)) -> a -> b
getBFst' (Int
0, [(String, Int)] -> Vector (String, Int)
forall a. [a] -> Vector a
V.fromList [(String
"-", Int
0), (String
"0", Int
1), (String
"1", Int
2), (String
"а", Int
3), (String
"б", Int
4),
                     (String
"в", Int
5), (String
"г", Int
6), (String
"д", Int
7), (String
"дж", Int
8), (String
"дз", Int
9), (String
"е", Int
10), (String
"ж", Int
11), (String
"з", Int
12), (String
"и", Int
13),
                        (String
"й", Int
14), (String
"к", Int
15), (String
"л", Int
16), (String
"м", Int
17), (String
"н", Int
18), (String
"о", Int
19), (String
"п", Int
20), (String
"р", Int
21),
                          (String
"с", Int
22), (String
"сь", Int
23), (String
"т", Int
24), (String
"у", Int
25), (String
"ф", Int
26), (String
"х", Int
27), (String
"ц", Int
28), (String
"ць", Int
29), (String
"ч", Int
30),
                            (String
"ш", Int
31), (String
"ь", Int
32), (String
"і", Int
33), (String
"ґ", Int
34)]) String
u
            else FinalException -> IO ()
catchEnd (String -> FinalException
DataFileNotClosed (Handle -> String
forall a. Show a => a -> String
show Handle
hdl))
        else FinalException -> IO ()
catchEnd (String -> FinalException
DataSoundFileNotRead String
"")) Vector String
xs
    Handle -> IO ()
hClose Handle
hdl
                       | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | The function that actually produces a .raw file. The mapping table is that one given in the @Map.txt@ file but not all sounds and files are present.
-- 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 :: (Vector String, [String]) -> Handle -> IO ()
appendS16LEFileList (Vector String
xs, [String]
yss) Handle
hdl | Bool -> Bool
not (Vector String -> Bool
forall a. Vector a -> Bool
V.null Vector String
xs) Bool -> Bool -> Bool
&& Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
yss) =
  do
    let intrm :: [String]
intrm = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String, Vector (String, String)) -> String -> String
forall a b. Ord a => (b, Vector (a, b)) -> a -> b
getBFst' (String
"0.wav", [(String, String)] -> Vector (String, String)
forall a. [a] -> Vector a
V.fromList ([(String, String)] -> Vector (String, String))
-> ([String] -> [(String, String)])
-> [String]
-> Vector (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"а",String
"б",String
"в",String
"г",String
"д",String
"дж",String
"дз",String
"е",String
"ж",String
"з",String
"и",String
"й",String
"к",String
"л",String
"м",String
"н",String
"о",String
"п",String
"р",String
"с",
                       String
"сь",String
"т",String
"у",String
"ф",String
"х",String
"ц",String
"ць",String
"ч",String
"ш",String
"ь",String
"і",String
"ґ"] ([String] -> Vector (String, String))
-> [String] -> Vector (String, String)
forall a b. (a -> b) -> a -> b
$ [String
"A.wav", String
"B.wav", String
"C.wav", String
"D.wav", String
"E.wav", String
"F.wav", String
"G.wav", String
"H.wav",
                         String
"I.wav", String
"J.wav", String
"K.wav", String
"L.wav", String
"M.wav", String
"N.wav", String
"O.wav", String
"P.wav", String
"Q.wav", String
"R.wav",
                           String
"S.wav", String
"T.wav", String
"U.wav", String
"V.wav", String
"W.wav", String
"X.wav", String
"Y.wav", String
"Z.wav", String
"a.wav", String
"b.wav", String
"c.wav",
                             String
"d.wav", String
"e.wav", String
"f.wav"])) [String]
yss
    Vector ByteString
dataList <- ((String -> IO ByteString)
-> Vector String -> IO (Vector ByteString)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM String -> IO ByteString
takeData (Vector String -> IO (Vector ByteString))
-> ([String] -> Vector String)
-> [String]
-> IO (Vector ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Vector String
forall a. [a] -> Vector a
V.fromList) ([String
"-.wav", String
"0.wav", String
"1.wav"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
intrm)
    (String -> IO ()) -> Vector String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (\String
u ->
      if (ByteString -> Bool) -> Vector ByteString -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all (\ByteString
z -> ByteString -> Int
BS.length ByteString
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Vector ByteString
dataList
        then let rs :: String
rs =  String -> String
forall a. [a] -> [a]
tail (String -> String) -> (Handle -> String) -> Handle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (String -> String) -> (Handle -> String) -> Handle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') (String -> String) -> (Handle -> String) -> Handle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String
forall a. Show a => a -> String
show (Handle -> String) -> Handle -> String
forall a b. (a -> b) -> a -> b
$ Handle
hdl in do
          Handle -> IO ()
hClose Handle
hdl
          Bool
closedHdl <- Handle -> IO Bool
hIsClosed Handle
hdl
          if Bool
closedHdl
            then String -> ByteString -> IO ()
BS.appendFile String
rs (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector ByteString
dataList Vector ByteString -> Int -> ByteString
forall a. Vector a -> Int -> a
V.! (Int, Vector (String, Int)) -> String -> Int
forall a b. Ord a => (b, Vector (a, b)) -> a -> b
getBFst' (Int
0, [(String, Int)] -> Vector (String, Int)
forall a. [a] -> Vector a
V.fromList ([(String, Int)] -> Vector (String, Int))
-> [(String, Int)] -> Vector (String, Int)
forall a b. (a -> b) -> a -> b
$ [(String
"-", Int
0), (String
"0", Int
1), (String
"1", Int
2)] [(String, Int)] -> [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a] -> [a]
++ [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
yss [Int
3..]) String
u
            else FinalException -> IO ()
catchEnd (String -> FinalException
DataFileNotClosed (Handle -> String
forall a. Show a => a -> String
show Handle
hdl))
        else FinalException -> IO ()
catchEnd (String -> FinalException
DataSoundFileNotRead String
"")) Vector String
xs
    Handle -> IO ()
hClose Handle
hdl
                                  | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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 :: IO ()
cleanCreatedSoundFs = do
  [String]
dirCs <- String -> IO [String]
listDirectory String
"."
  let remFs :: [String]
remFs = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
ys -> (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
zs -> String
ys String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
zs) [String]
dirCs) [String
".raw", String
".wav", String
".ogg", String
".flac"] in (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
removeFile [String]
remFs