-- |
-- Module      :  Processing_mmsyn7ukr
-- Copyright   :  (c) OleksandrZhabenko 2019-2022
-- License     :  MIT
-- Stability   :  Experimental
-- 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 approximately Ukrainian speech with your own recorded 
-- voice (actually it produces the needed sound representations).
--


module Processing_mmsyn7ukr_array (
 -- * Producing sound
  produceSound2
  , produceSound3
  , produceSound4
  , beginProcessing
  , controlNoiseReduction
  -- * Additional functions
  , tempS
  , showCoef
  , tempeRa
  -- ** Informational messages printing functions
  , printGenInfo0
  , printGenInfo1
  , printGenInfo2
  , recommendSharp
  -- * Cleaning
  , cleanTemp
  , cleanTempN
) where

import Control.Concurrent (threadDelay)
import Data.Typeable
import Numeric
import System.Directory
import Control.Exception (onException)
import EndOfExe (showE)
import Data.Maybe (fromJust)
import Data.Char
import qualified Data.List as L
import qualified Control.Monad as CM
import System.Process
import System.IO
import System.Info (os)
import System.Environment (getProgName)
import System.Exit
import SoXBasics.Arr
import CaseBi.Arr (getBFst')
import GHC.Arr
import ReplaceP.Arr (replaceP, replaceP4)
import Control.Exception.FinalException.Arr

-- | Function 'produceSound3' is used internally in the 'produceSound2' function.
produceSound3 :: (String, String) -> (FilePath, FilePath) -> String -> (Int, Float) -> Float -> IO ()
produceSound3 :: (String, String)
-> (String, String) -> String -> (Int, Float) -> Float -> IO ()
produceSound3 (String
actsctrl, String
noiseLim) (String
file, String
file1) String
soundUkr (Int
noiseMax, Float
duration0) Float
lim0
 | String
actsctrl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-1" = (String, String) -> (String, String) -> String -> IO ()
prodSnd3H (String
actsctrl, String
noiseLim) (String
file, String
file1) String
soundUkr
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
actsctrl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" = (String, String) -> (String, String) -> String -> IO ()
prodSnd3H (String
actsctrl, String
noiseLim) (String
file, String
file1) String
soundUkr
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
actsctrl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1" = do
     (String, String)
-> (String, String) -> String -> (Int, Float) -> Float -> IO Float
prodSnd3H2 (String
actsctrl, String
noiseLim) (String
file, String
file1) String
soundUkr (Int
noiseMax, Float
duration0) Float
lim0 IO Float -> (Float -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Float
lim1 -> 
       if Float
lim1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0 then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Int -> IO ()
resampleA String
"8_x.wav" (Int
22050::Int) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, String) -> String -> IO ()
produceSound4 (String
file, String
file1) String
"38_x.wav"
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
actsctrl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"2" = do
    (String, String)
-> (String, String) -> String -> (Int, Float) -> Float -> IO Float
prodSnd3H2 (String
actsctrl, String
noiseLim) (String
file, String
file1) String
soundUkr (Int
noiseMax, Float
duration0) Float
lim0 IO Float -> (Float -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Float
lim1 -> 
     if Float
lim1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0 then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> IO ()
sincA String
"8_x.wav" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Int -> IO ()
resampleA String
"4.8_x.wav" (Int
22050::Int) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, String) -> String -> IO ()
produceSound4 (String
file, String
file1) String
"34.8_x.wav"
 | Bool
otherwise = do
    (String, String)
-> (String, String) -> String -> (Int, Float) -> Float -> IO Float
prodSnd3H2 (String
actsctrl, String
noiseLim) (String
file, String
file1) String
soundUkr (Int
noiseMax, Float
duration0) Float
lim0 IO Float -> (Float -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Float
lim1 -> 
     if Float
lim1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0 then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> IO ()
sincA String
"8_x.wav" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Int -> IO ()
resampleA String
"4.8_x.wav" (Int
22050::Int) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
quarterSinFade String
"34.8_x.wav" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
       (String, String) -> String -> IO ()
produceSound4 (String
file, String
file1) String
"434.8_x.wav"

prodSnd3H :: (String, String) -> (FilePath, FilePath) -> String -> IO ()
prodSnd3H :: (String, String) -> (String, String) -> String -> IO ()
prodSnd3H (String
actsctrl, String
noiseLim) (String
file, String
file1) String
soundUkr = do 
    Float
lim1 <- String -> IO Float
durationA String
"8_x.wav"
    if Float
lim1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0
      then (String, String) -> String -> (String, String) -> IO ()
beginProcessing (String
file, String
file1) String
soundUkr (String
actsctrl, String
noiseLim)
      else do 
        String -> Int -> IO ()
resampleA String
"8_x.wav" (Int
22050::Int)
        (String, String) -> String -> IO ()
produceSound4 (String
file, String
file1)  String
"38_x.wav"

prodSnd3H2 :: (String, String) -> (FilePath, FilePath) -> String -> (Int, Float) ->  Float -> IO Float
prodSnd3H2 :: (String, String)
-> (String, String) -> String -> (Int, Float) -> Float -> IO Float
prodSnd3H2 (String
actsctrl, String
noiseLim) (String
file, String
file1) String
soundUkr (Int
noiseMax, Float
duration0) Float
lim0 = do
    String -> Float -> Int -> Float -> IO ()
alterVadB String
"8_x.wav" Float
lim0 Int
noiseMax (Float
duration0Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
0.03)
    Float
lim1 <- String -> IO Float
durationA String
"8_x.wav"
    if Float
lim1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0
      then (String, String) -> String -> (String, String) -> IO ()
beginProcessing (String
file, String
file1) String
soundUkr (String
actsctrl, String
noiseLim)
      else String -> Float -> Int -> Float -> IO ()
alterVadE String
"8_x.wav" Float
lim1 Int
noiseMax (Float
duration0Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
0.03)
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
lim1

-- | Function 'produceSound4' is used internally in the 'produceSound3' function for amplification 
-- up/down to the maximum level of the first @FilePath@ parameter in the tuple. The second one gives 
-- a name of the resulting file and the third @FilePath@ parameter of the function is the @FilePath@ for 
-- the input file.
produceSound4 :: (FilePath, FilePath) -> FilePath -> IO ()
produceSound4 :: (String, String) -> String -> IO ()
produceSound4 (String
file, String
file1) String
fileB = do 
  String -> IO ()
norm String
fileB
  String -> String -> IO ()
volS2 (String
"8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fileB) String
file
  String -> String -> IO ()
renameFile (String
"8." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fileB) String
file1

-- | Function 'showCoef' is used to represent the duration of the sound file.
showCoef :: String -> String
showCoef :: String -> String
showCoef String
xs | Char
'.' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
xs = 
  let (String
ts, String
us) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
xs in let ws :: String
ws = Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6) ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. Read a => String -> a
read (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
6 (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
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
us)::Int) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000000.0) String
"" in 
    String
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
ws
            | Bool
otherwise = String
xs
      
-- | Function 'beginProcessing' is used to catch the variant where the sound is fully cut by the SoX because the sound was created in inappropriate time.
-- It returns the process to the beginning of the sound recording. For the meaning of the tuple of @Sring@ parameters, refer to 
-- 'produceSound' documentation. The first @FilePath@ in the tuple of @FilePath@ parameters is a name of the sound file in @mmsyn6ukr-array@ package. The second one is the 
-- name of the resulting file to be produced in the current directory.
beginProcessing :: (FilePath, FilePath) -> String -> (String, String) -> IO ()
beginProcessing :: (String, String) -> String -> (String, String) -> IO ()
beginProcessing (String
file, String
file1) String
soundUkr (String
actsctrl, String
noiseLim) = do {
  IO ()
cleanTemp
; String -> IO ()
putStr String
"The needed files were NOT created, because the sound was not at the moment of recording! The process will be restarted "
; String -> IO ()
putStrLn String
"for the sound. Please, produce a sound during the first 3 seconds (after 0.5 second delay) or specify greater ratio!"
; String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Listen to the \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
soundUkr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" sound and note first of all its duration. "
; String -> IO ()
playA String
file
; String -> IO ()
putStrLn String
"    *****"
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStrLn String
"The sound duration is: "
; (String, String) -> (String, String) -> String -> IO ()
produceSound2 (String
file, String
file1) (String
actsctrl, String
noiseLim) String
soundUkr}

-- | Function 'produceSound2' is used internally in the 'produceSound' function.
produceSound2 :: (FilePath, FilePath) -> (String, String) -> String -> IO ()
produceSound2 :: (String, String) -> (String, String) -> String -> IO ()
produceSound2 (String
file, String
file1) (String
actsctrl, String
noiseLim) String
soundUkr = do {
; Float
duration0 <- String -> IO Float
durationA String
file
; String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
showCoef (Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6) Float
duration0 String
"")
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStrLn String
"It means that to produce more than 3 seconds of recording, you must specify at least "
; String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show (Float
3.0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
duration0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" as a next step ratio being prompt "
; String -> IO ()
putStrLn String
"   OR "
; String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show (Float
1.0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
duration0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" per one second but not less than the previous number."
; String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"For example for 10 seconds record, please, specify " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show (Float
10.0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
duration0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" as a next step ratio."
; String -> IO ()
putStrLn String
"    *****"
; String -> IO ()
putStrLn String
""
; (Maybe Handle
_, Just Handle
hout, Maybe Handle
_, ProcessHandle
_) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc (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
"soxi") [String
"-D", String
file]) { std_out :: StdStream
std_out = StdStream
CreatePipe }
; String
x3 <- Handle -> IO String
hGetContents Handle
hout
; String -> IO ()
recommendSharp String
soundUkr
; (Float
longerK0,Float
pause0,Bool
sharp) <- String -> String -> IO (Float, Float, Bool)
tempS String
soundUkr String
noiseLim
; let longerK :: Float
longerK = (String -> Float
forall a. Read a => String -> a
read String
x3::Float)Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
longerK0
; String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Please, wait for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
pause0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" seconds and pronounce the sound representation for the "
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"                                   \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if String
soundUkr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"ь" then (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
soundUkr else String
soundUkr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStrLn String
" sound or whatever you would like to be substituted instead (be sensible, please)! "
; if Bool
sharp Bool -> Bool -> Bool
|| (Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
longerK Float
3.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT)
    then String -> (Float, Float) -> IO ()
recB String
"x.wav" (Float
longerK, Float
pause0)
    else String -> (Float, Float) -> IO ()
recB String
"x.wav" (Float
3.0, Float
pause0)
; String -> IO ()
putStrLn String
"The file is recorded and now will be automatically processed. You will be notificated with the text message in the terminal about the creation of the needed file. Please, wait a little. "
; String -> IO ()
controlNoiseReduction String
actsctrl
; String -> IO ()
norm String
"_x.wav"
; Float
lim0 <- String -> IO Float
durationA String
"8_x.wav" 
; if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
noiseLim
    then IO ()
printGenInfo1
    else if String -> Char
forall a. [a] -> a
last String
noiseLim Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
's'
           then String -> IO ()
putStr String
""
           else IO ()
printGenInfo1
; let noiseMax :: Int
noiseMax = case (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
noiseLim) of
                   String
"0" -> Int
0::Int
                   String
"1" -> Int
1::Int
                   String
"2" -> Int
2::Int
                   String
"3" -> Int
3::Int
                   String
_ -> Int
2::Int
; (String, String)
-> (String, String) -> String -> (Int, Float) -> Float -> IO ()
produceSound3 (String
actsctrl, String
noiseLim) (String
file, String
file1) String
soundUkr (Int
noiseMax, Float
duration0) Float
lim0
; IO ()
cleanTemp }

-- | Function 'printGenInfo1' prints the general information about behaviour of the program in case of the different specified first two command line
-- arguments. If in the second command line argument there is letter \'s\' at the end, then the printing is omitted.
printGenInfo1 :: IO ()
printGenInfo1 :: IO ()
printGenInfo1 = do {
String -> IO ()
putStrLn String
""
; String -> IO ()
putStrLn String
"If you specified as a first command line argument one of the numbers below the program behaves as follows: "
; String -> IO ()
putStrLn String
"-1 -> the program does not reduce noise, it only resamples the audio to the needed 22050 Hz and adjusts the amplitude;"
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStr String
"If you specified something else then the program will reduce the noise using the created noise profile. If the first character is one of the "
; String -> IO ()
putStr String
"following, then the program will do the following actions besides. After the first character (without any spaces) you can specify "
; String -> IO ()
putStr String
"the level of noise reduction by 2 next digits. They are treated by the program as a fractional part of the number \"0.\" ++ \"...\" "
; String -> IO ()
putStr String
"so that the last number is passed to the SoX as an amount parameter in the \"noisered\" effect (the greater number gives more aggressive "
; String -> IO ()
putStrLn String
"noise reduction with the default one equal to 0.5. For more information, please, refer to the SoX documentation. "
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStrLn String
"Therefore, if you specify as a first symbol in the first command line argument one of the following numbers, then the program will behave: "
; String -> IO ()
putStrLn String
"0 -> after the noise reduction the program only resamples the audio to the needed 22050 Hz and adjusts the amplitude; "
; String -> IO ()
putStrLn String
"1 -> after the noise reduction the program additionally to the 0-processing truncates the silence from the beginning and end of the audio to the level given by the second command line parameter; "
; String -> IO ()
putStrLn String
"2 -> after the noise reduction the program additionally to the 1-processing applies a double band-reject filter to the audio (SoX \'sinc\' effect); "
; String -> IO ()
putStrLn String
"3 -> after the noise reduction the program additionally to the 2-processing applies fade-in and fade-out effects to the audio; "
; String -> IO ()
putStrLn String
"_ -> is the same as 3. "
; String -> IO ()
putStrLn String
"         ----------------------            "
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStrLn String
"If you specify at the beginning of a second command line argument one of the numbers below the program behaves as follows: "
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStr String
"0 -> if the first character in the first command line argument is greater or equal to 1, "
; String -> IO ()
putStr String
"then the program trims the sound at the beginning and at the end of it. "
; String -> IO ()
putStr String
"It firstly normalizes the sound (so its maximum amplitude is equal to 1) "
; String -> IO ()
putStr String
"and then applies trimming. The parts of the audio at the beginning "
; String -> IO ()
putStr String
"and at the end of the sound, which amplitudes in such a case are "
; String -> IO ()
putStr String
"less than 0.01 are trimmed and the resulting sound data are processed "
; String -> IO ()
putStrLn String
"further.  "
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStr String
"1 -> if the first character in the first command line argument is greater or equal to 1, "
; String -> IO ()
putStr String
"then the program trims the sound at the beginning and at the end of it. "
; String -> IO ()
putStr String
"It firstly normalizes the sound (so its maximum amplitude is equal to 1) "
; String -> IO ()
putStr String
"and then applies trimming. The parts of the audio at the beginning "
; String -> IO ()
putStr String
"and at the end of the sound, which amplitudes in such a case are "
; String -> IO ()
putStr String
"less than 0.02 are trimmed and the resulting sound data are processed "
; String -> IO ()
putStrLn String
"further.  "
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStr String
"2 -> if the first character in the first command line argument is greater or equal to 1, "
; String -> IO ()
putStr String
"then the program trims the sound at the beginning and at the end of it. "
; String -> IO ()
putStr String
"It firstly normalizes the sound (so its maximum amplitude is equal to 1) "
; String -> IO ()
putStr String
"and then applies trimming. The parts of the audio at the beginning "
; String -> IO ()
putStr String
"and at the end of the sound, which amplitudes in such a case are "
; String -> IO ()
putStr String
"less than 0.04 are trimmed and the resulting sound data are processed "
; String -> IO ()
putStrLn String
"further.  "
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStr String
"3 -> if the first character in the first command line argument is greater or equal to 1, "
; String -> IO ()
putStr String
"then the program trims the sound at the beginning and at the end of it. "
; String -> IO ()
putStr String
"It firstly normalizes the sound (so its maximum amplitude is equal to 1) "
; String -> IO ()
putStr String
"and then applies trimming. The parts of the audio at the beginning "
; String -> IO ()
putStr String
"and at the end of the sound, which amplitudes in such a case are "
; String -> IO ()
putStr String
"less than 0.08 are trimmed and the resulting sound data are processed "
; String -> IO ()
putStrLn String
"further.  "
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStr String
"_ -> if the first character in the first command line argument is greater or equal to 1, "
; String -> IO ()
putStr String
"then the program trims the sound at the beginning and at the end of it. "
; String -> IO ()
putStr String
"It firstly normalizes the sound (so its maximum amplitude is equal to 1) "
; String -> IO ()
putStr String
"and then applies trimming. The parts of the audio at the beginning "
; String -> IO ()
putStr String
"and at the end of the sound, which amplitudes in such a case are "
; String -> IO ()
putStr String
"less than 0.04 are trimmed and the resulting sound data are processed "
; String -> IO ()
putStrLn String
"further. So effectively it is the same as 2 (the default value). "
; String -> IO ()
putStrLn String
""
; String -> IO ()
putStrLn String
"         ----------------------            "
; String -> IO ()
putStr String
"You can shorten the information printed during the program execution by specifying as the "
; String -> IO ()
putStr String
"last symbol in the second command line argument an \'s\'. In such a case, the program omits "
; String -> IO ()
putStr String
"printing the much of its informational messages that are used mostly for the learning "
; String -> IO ()
putStr String
"to deal with the program. If you specified the second command line argument without the \'s\' "
; String -> IO ()
putStrLn String
"at the end, then the program prints all the additional information that is considered important."
; String -> IO ()
putStrLn String
"" }

-- | Function 'controlNoiseReduction' is used in the 'produceSound2' and 'beginProcessing' functions to reduce the noise with the created by the
-- 'tempeRa' noise profile. If you specified something else than \"-1\" as a first command line argument, then the program will reduce the noise
-- using the created noise profile. 
-- If the first character is one of the following, then the program will do the following actions besides. After the first character
-- (without any spaces) you can specify the level of noise reduction by 2 next digits. They are treated by the program as a fractional part
-- of the number \"0.\" ++ \"...\" so that the last number is passed to the SoX as an amount parameter in the \"noisered\" effect
-- (the greater number gives more aggressive noise reduction with the default one equal to 0.5. For more information, please, refer to the SoX documentation. 
controlNoiseReduction :: String -> IO ()
controlNoiseReduction :: String -> IO ()
controlNoiseReduction String
actsctrl = if String
actsctrl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-1"
    then do
      Float
s2 <- IO Float -> IO Double -> IO Float
forall a b. IO a -> IO b -> IO a
onException (do
              let s1 :: String
s1 = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
actsctrl
                  sr0 :: String
sr0 = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit (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
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
actsctrl
              if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sr0
                then Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
0.5
                else let sr :: String
sr = String
"0." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sr0
                         s :: Float
s  = String -> Float
forall a. Read a => String -> a
read String
sr::Float in if Float
s Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.0 then Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
s else Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
0.01) (Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
0.5)
      (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
"x.wav", String
"_x.wav", String
"noisered", String
"nx0.wav.b.prof", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
s2 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0] String
""
      if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess 
        then do
          Bool
e1 <- String -> IO Bool
doesFileExist String
"_x.wav"
          if Bool
e1
            then do
              String -> IO ()
removeFile String
"_x.wav"
              FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
            else FinalException -> IO ()
catchEnd (String -> FinalException
NotCreatedWithEffect String
"noisered")
        else do 
          Bool
e2 <- String -> IO Bool
doesFileExist String
"_x.wav"
          if Bool
e2 
            then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else FinalException -> IO ()
catchEnd (String -> FinalException
InitialFileNotChanged String
"x.wav")
    else String -> String -> IO ()
renameFile String
"x.wav" String
"_x.wav"

-- | Function to get the @(Float, Float, Bool)@ value. The first @Float@ value shows in how many times you expect that your sound representation
-- will be longer than the one provided by the @mmsyn6ukr-array@ package. The second one specifies a duration of the pause before SoX actually starts to
-- record the needed sound data (in seconds). The @Bool@ value specifies whether the program uses a \'sharp\' mode meaning that
-- it does not check whether the resulting duration of the recording is at least 3 seconds long, so you can specify shorter durations.
-- The @String@ arguments are the Ukrainian sound representation name and the second command line argument for the program respectively.
tempS :: String -> String -> IO (Float, Float, Bool)
tempS :: String -> String -> IO (Float, Float, Bool)
tempS String
soundUkr String
noiseLim = IO (Float, Float, Bool)
-> IO (Float, Float, Bool) -> IO (Float, Float, Bool)
forall a b. IO a -> IO b -> IO a
onException (do
    if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
noiseLim
      then IO ()
printGenInfo2
      else if String -> Char
forall a. [a] -> a
last String
noiseLim Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
's'
             then String -> IO ()
putStr String
""
             else IO ()
printGenInfo2
    String -> IO ()
putStrLn String
"In how many times do you think your sound representing " 
    String -> IO ()
putStrLn String
""
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"                     \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if String
soundUkr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"ь" then (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
soundUkr else String
soundUkr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" 
    String -> IO ()
putStrLn String
""
    String -> IO ()
putStrLn String
"will sound longer than the recently played one? Specify your input as a Float value without \'e\' notation (with the preceding asterisk sign for the \'sharp\' mode). "
    String -> IO ()
putStrLn String
""
    String
longivityZ <- IO String
getLine
    let sharp0 :: String
sharp0 = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
longivityZ
        sharp1 :: String
sharp1 = 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
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
longivityZ
        sharp2 :: Float
sharp2 = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sharp1 then Float
0.5 else let zzz0 :: Float
zzz0 = String -> Float
forall a. Read a => String -> a
read ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
z -> Char -> Bool
isDigit Char
z Bool -> Bool -> Bool
|| Char
z Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
sharp1)::Float in if Float
zzz0 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float
zzz0 else Float
0.5
    case String
sharp0 of
      String
"*" -> let long :: Float
long = String -> Float
forall a. Read a => String -> a
read ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') (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
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
longivityZ)::Float in (Float, Float, Bool) -> IO (Float, Float, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
long,Float
sharp2,Bool
True)
      String
_   -> let long :: Float
long = String -> Float
forall a. Read a => String -> a
read ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') String
longivityZ)::Float in (Float, Float, Bool) -> IO (Float, Float, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
long,Float
sharp2,Bool
False)) (do 
               String -> IO ()
putStrLn String
"Please, specify again the valid values!"
               String -> String -> IO (Float, Float, Bool)
tempS String
soundUkr String
noiseLim)

-- | Function 'printGenInfo2' prints the additional information about the \'sharp\' mode and the possibility to specify the duration of the
-- pause before the SoX executable actuall starts recording of the sound representation.
-- If in the second command line argument there is letter \'s\' at the end, then the printing is omitted.
printGenInfo2 :: IO ()
printGenInfo2 :: IO ()
printGenInfo2 = do
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"IMPORTANT. Would you like to use a \'sharp\' mode for this sound representaiion? (Enter \'*\' as the first symbol in your next input to use the "
  String -> IO ()
putStr String
"\'sharp\' mode, in which the program does not use 3 seconds minimal limit to record the sound representation, "
  String -> IO ()
putStr String
"but a recording duration is no more than the one specified by your entered ratio). For not using the \'sharp\' mode, "
  String -> IO ()
putStrLn String
"enter your next input without the asterisk."
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStrLn String
"IMPORTANT 2. After specifying the ratio you can input \'#\' sign and specify after it the duration (in seconds) of the needed pause before SoX will actually start recording of the sound data. The default one is 0.5 seconds if nothing is specified. This also provides backward compatibility of the program."
  String -> IO ()
putStrLn String
""

-- | Function 'cleanTemp' removes all the intermediate temporary files in the directory where it is called from.
cleanTemp :: IO ()
cleanTemp :: IO ()
cleanTemp = do
  [String]
filenames <- String -> IO [String]
getDirectoryContents (String -> IO [String]) -> IO String -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
getCurrentDirectory
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
removeFile ([String] -> IO ()) -> ([String] -> [String]) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> String -> Char
forall a. [a] -> a
head String
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char
'2'..Char
'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"x")) ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String]
filenames

-- | Function 'cleanTempN' removes all the intermediate temporary files produced during a noise profile creation in the directory where it is called from.
cleanTempN :: IO ()
cleanTempN :: IO ()
cleanTempN = do
  [String]
filenames <- String -> IO [String]
getDirectoryContents (String -> IO [String]) -> IO String -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
getCurrentDirectory
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
removeFile ([String] -> IO ()) -> ([String] -> [String]) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> String -> Char
forall a. [a] -> a
head String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'n') ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String]
filenames

-- | Function 'tempeRa' is used to create a noise profile for all the recorded sounds. The function is used internally in the @mmsyn7ukr@
-- program. While running if you provide a 5 seconds silence as needed, the program @mmsyn7ukr@ will
-- reduce the noise in your recordings. This will create a cleaner sound. If you would like not to reduce the noise at all, then, please,
-- specify \"-1\" as the first command line argument for the program @mmsyn7ukr@.
tempeRa :: Int -> IO ()
tempeRa :: Int -> IO ()
tempeRa Int
n = do {
    String -> IO ()
putStrLn String
"Now, please, be in a silence for 5 seconds so that the program can create a noise profile to remove the noise from the recording. "
    ; String -> IO ()
putStr String
"Otherwise, the program can remove from the recorded sound data some important parts as a noise. "
    ; if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String -> IO ()
putStrLn String
"If you would like not to reduce the noise at all, then, please, specify as the first command line argument \"-1\". "
      else String -> IO ()
putStr String
""
    ; (Integer -> Int -> IO ()) -> [Integer] -> [Int] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
CM.zipWithM_ (\Integer
i Int
x -> String -> Float -> IO ()
recA (String
"nx" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".wav") Float
0.07 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
threadDelay (Int
50000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x)) [Integer
1..Integer
5] ([Int] -> IO ()) -> [Int] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Int
2,Int
3,Int
2,Int
2,Int
3]
    ; [Int
upperB1,Int
upperB2,Int
upperB3,Int
upperB4,Int
upperB5] <- (Char -> IO Int) -> String -> IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Char
c -> String -> IO Int
upperBnd (String
"nx" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
".wav"))) String
"12345"
    ; [Float]
v0 <- (Integer -> Int -> IO Float) -> [Integer] -> [Int] -> IO [Float]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
CM.zipWithM (\Integer
i Int
upp -> ((String, Bool) -> Float) -> IO (String, Bool) -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String, Bool)
kt -> Float -> Float
forall a. Num a => a -> a
abs (String -> Float
forall a. Read a => String -> a
read ((String, Bool) -> String
forall a b. (a, b) -> a
fst (String, Bool)
kt)::Float))  (IO (String, Bool) -> IO Float)
-> ((Int, Int) -> IO (String, Bool)) -> (Int, Int) -> IO Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Int, Int) -> IO (String, Bool)
selMaxAbs (String
"nx" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".wav") ((Int, Int) -> IO Float) -> (Int, Int) -> IO Float
forall a b. (a -> b) -> a -> b
$ (Int
0,Int
upp)) [Integer
1..Integer
5] ([Int] -> IO [Float]) -> [Int] -> IO [Float]
forall a b. (a -> b) -> a -> b
$ [Int
upperB1,Int
upperB2,Int
upperB3,Int
upperB4,Int
upperB5]
    ; let minn :: Float
minn = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
v0 in String -> String -> IO ()
renameFile (String
"nx" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show ((Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> ([Float] -> Maybe Int) -> [Float] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Bool) -> [Float] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex (Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
minn) ([Float] -> Int) -> [Float] -> Int
forall a b. (a -> b) -> a -> b
$ [Float]
v0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".wav")) String
"nx0.wav"
    ; String -> IO ()
noiseProfB String
"nx0.wav" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
threadDelay Int
400000 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"The noise sound profile is now created. The program can proceed further." }

-- | Function 'recommendSharp' is used to print an advice about the speech transformation for the Ukrainian sounds that you can pronounce
-- properly continually and so it can be better to use for their producing a \'sharp\' mode.
recommendSharp :: String -> IO ()
recommendSharp :: String -> IO ()
recommendSharp String
soundUkr = do
  let k0 :: Bool
k0 = (Bool, Array Int (String, Bool)) -> String -> Bool
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Bool
False, (Int, Int) -> [(String, Bool)] -> Array Int (String, Bool)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
16) ([(String, Bool)] -> Array Int (String, Bool))
-> ([Bool] -> [(String, Bool)])
-> [Bool]
-> Array Int (String, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Bool] -> [(String, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"\1072",String
"\1077",String
"\1078",String
"\1079",String
"\1080",String
"\1083",String
"\1084",String
"\1085",String
"\1086",String
"\1088",String
"\1089",String
"\1089\1100",String
"\1091",String
"\1092",String
"\1093",String
"\1096",String
"\1110"] ([Bool] -> Array Int (String, Bool))
-> [Bool] -> Array Int (String, Bool)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
17 Bool
True) String
soundUkr
  if Bool
k0
    then do
      String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"In case of speech transformation: for the sound representation for the Ukrainian \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
soundUkr
      String -> IO ()
putStrLn String
"\" it is recommended to use a \'sharp\' mode. So, try to specify \'*\' as a first symbol and maybe pronounce the corresponding Ukrainian sound continually. "
    else do
      String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"In case of speech transformation: for the sound representation for the Ukrainian \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
soundUkr
      String -> IO ()
putStrLn String
"\" it is recommended to use a common mode (the usual one). So, try not to specify \'*\' as a first symbol. "

-- | Function 'printGenInfo0' prints once the general information if in the second command line argument there is no letter \'s\' at the end.
printGenInfo0 :: IO ()
printGenInfo0 :: IO ()
printGenInfo0 = do
  String -> IO ()
putStr String
"The program mmsyn7ukr produces the \"voice\" represented as an ordered "
  String -> IO ()
putStr String
"set of sounds each of which corresponds (represents) one of the "
  String -> IO ()
putStr String
"Ukrainian sounds so that using them together by mmsyn7h program "
  String -> IO ()
putStr String
"(https://hackage.haskell.org/package/mmsyn7h) can be a background "
  String -> IO ()
putStr String
"for sound synthesis. If you pronounce sounds as the appropriate "
  String -> IO ()
putStr String
"Ukrainian ones, close to proper Ukrainian speech with your own "
  String -> IO ()
putStr String
"voice. This program approximates your voice with a sequence "
  String -> IO ()
putStr String
"of recorded separate sounds with your control over the "
  String -> IO ()
putStr String
"duration of the sounds. They are then precessed by the SoX "
  String -> IO ()
putStr String
"binaries already installed in the system to produce the "
  String -> IO ()
putStr String
"needed sounds and then you can pronounce some Ukrainian text "
  String -> IO ()
putStr String
"with your recorded \"voice\" using mmsyn7h program. In-between "
  String -> IO ()
putStr String
"you can do some additional processing as you need. Moreover, "
  String -> IO ()
putStr String
"you can substitute whatever sounds you like (consider being "
  String -> IO ()
putStrLn String
"sensible) instead of your own voice."
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"Be aware that if somebody can get access to the sounds of "
  String -> IO ()
putStr String
"your voice or to the recorded speech (except you) then this "
  String -> IO ()
putStr String
"possibility itself creates security issues and concerns. So, "
  String -> IO ()
putStr String
"please, do NOT give access to such records to anybody else "
  String -> IO ()
putStrLn String
"except you."
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"In such a case, the program is for personal usage of every "
  String -> IO ()
putStrLn String
"user ONLY!"
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"Being given as an advice in such a case, run the program "
  String -> IO ()
putStr String
"in the empty directory with the current user permissions to write, "
  String -> IO ()
putStr String
"read and search and provide some proofs and evidence that nobody else "
  String -> IO ()
putStr String
"can even read the files in the directory. May be, it is better "
  String -> IO ()
putStr String
"to execute the program being in the directory located in the RAM, "
  String -> IO ()
putStr String
"then consequently wait until the program ends and then reboot "
  String -> IO ()
putStrLn String
"the computer. "
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"If the program ends earlier, you must then remove "
  String -> IO ()
putStr String
"(better wipe) the directory contents. No other users should "
  String -> IO ()
putStr String
"have access to the computer after you have begun to run the "
  String -> IO ()
putStr String
"program and have not deleted (or better wiped) the contents "
  String -> IO ()
putStr String
"of the directory. Please, be aware, that there are possibilities "
  String -> IO ()
putStr String
"to read sensitive information from the drives after you have "
  String -> IO ()
putStr String
"deleted the files in a usual way. You can use wiping for better "
  String -> IO ()
putStr String
"security. Besides, if somebody can get access to the memory of "
  String -> IO ()
putStr String
"the computer or to the directory contents where you run the "
  String -> IO ()
putStr String
"program or (may be) to the temporary files created by SoX or "
  String -> IO ()
putStr String
"to the drive where you run the program (not in the RAM, or may "
  String -> IO ()
putStr String
"be in it) then your voice can be stolen and / or used "
  String -> IO ()
putStr String
"inappropriately. Use all possible precautions and measures to "
  String -> IO ()
putStrLn String
"avoid the situation. "
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"Be aware also that the given by the program technology (or "
  String -> IO ()
putStr String
"documentation for it in any form) of the voice processing can "
  String -> IO ()
putStr String
"be improved so there is NO guarantees that the given technology "
  String -> IO ()
putStr String
"or its successors cannot be used in violating your voice identity "
  String -> IO ()
putStr String
"to produce from some available voice records the voice for the "
  String -> IO ()
putStr String
"inappropriate usage. Therefore, better is to proove your identity not "
  String -> IO ()
putStr String
"only with the solely voice itself but with some additional "
  String -> IO ()
putStrLn String
"independent sources and measures. "
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"The author of the program accordingly to the LICENSE (MIT) does not "
  String -> IO ()
putStr String
"response for any possible issues, but by this notification tries to "
  String -> IO ()
putStrLn String
"intent you to be aware of some possible issues."
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStrLn String
"           ***** More Information *****"
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"You can create a sound in either a \'sharp\' mode or in a usual mode."
  String -> IO ()
putStr String
"The first one means that the program does not check whether the"
  String -> IO ()
putStr String
"specified duration for recording the initial sound data"
  String -> IO ()
putStr String
"is greater than 3 seconds. In such a case the duration can be"
  String -> IO ()
putStr String
"much smaller. This mode needs more mastership in interacting with a"
  String -> IO ()
putStr String
"program. For speech synthesis (as an advice) use this mode for"
  String -> IO ()
putStr String
"the very short sounds (like the sound representation for \"ь\")"
  String -> IO ()
putStr String
"or for the sounds, you can articulate for a long time continually"
  String -> IO ()
putStr String
"(for example, vowels and some consonants). The \'sharp\' mode delegates"
  String -> IO ()
putStr String
"the responsibility for the sound to much broader extent to the user,"
  String -> IO ()
putStrLn String
"so for a beginning it is not recommended (though you can give it a try)."
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"At the beginning the program also creates a noise profile (once per execution)."
  String -> IO ()
putStr String
"It is now used to reduce the noise level for the recorded sound representations."
  String -> IO ()
putStr String
"It uses the default SoX noise reducing settings with a hope that for you they can"
  String -> IO ()
putStrLn String
"be sufficient."
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStrLn String
"           ***** Ukrainian Localization *****"
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStr String
"Please, before using the program check that uk_UA.UTF8 localization is"
  String -> IO ()
putStr String
"present in your system as one of the system locales. Otherwise,"
  String -> IO ()
putStr String
"the program will possibly (in some cases surely) cycle. In such a case,"
  String -> IO ()
putStrLn String
"you can terminate it in a usual way by sending interruption signals."
  String -> IO ()
putStrLn String
""