{-# OPTIONS_HADDOCK show-extensions #-}

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

module Melodics.Executable.Arr (
  circle
  , workWithInput
  , rawToSoundFile
  , printInfoF
  , printEnding
  , recFileName
)
where

import Data.Char (isSpace, isControl)
import Data.Maybe (isJust,fromJust)
import System.IO
import System.Process (callProcess)
import System.Directory (removeFile)
import Control.Exception (onException)
import EndOfExe (showE)
import Melodics.Ukrainian.Arr (appendULFile)
import Melodics.Ukrainian.ArrInt8
import UkrainianLControl.Arr

-- | Is used to repeat the cycle of creation of the sound files in the current directory for the @mmsyn6ukr@  executable.
circle :: String -> Bool -> FilePath -> IO ()
circle :: String -> Bool -> String -> IO ()
circle String
zs Bool
onepass String
file
 | Bool
onepass = IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (String -> Bool -> String -> Int -> IO ()
workWithInput String
zs Bool
True String
file Int
1) (String -> IO ()
printEnding String
zs)
 | Bool
otherwise = IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException ((Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Bool -> String -> Int -> IO ()
workWithInput String
zs Bool
False String
file) [Int
1..]) (String -> IO ()
printEnding String
zs)

printEnding :: String -> IO ()
printEnding :: String -> IO ()
printEnding String
xs = do
  String -> IO ()
putStr String
"Notice, there was (may be) CmdLineArgument exception. To avoid it, please, specify the command line argument (if needed) in the form \"ABC\""
  String -> IO ()
putStr 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 "
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"the command line arguments " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Please, check also whether the SoX was installed with the support for needed codec"
{-# INLINE printEnding #-}

-- | Interactively creates sound files in the current directory for the Ukrainian text input. Is used internally in the 'circle'
workWithInput :: String -> Bool -> FilePath -> Int -> IO ()
workWithInput :: String -> Bool -> String -> Int -> IO ()
workWithInput String
zs Bool
onepass String
file Int
_ = do
 [String
nameSF,String
ys] <- if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
file then String -> Bool -> String -> [Int] -> IO [String]
nameAndControl String
zs Bool
onepass String
file [Int
1,Int
2] else String -> Bool -> String -> [Int] -> IO [String]
nameAndControl String
zs Bool
onepass String
file [Int
1,Int
3]
 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
".ul") IOMode
AppendMode (FlowSound -> Handle -> IO ()
appendULFile (String -> FlowSound
convertToProperUkrainianI8 (if Bool
onepass then [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
ys else String
ys)))
 String -> IO ()
putStrLn String
"The .ul file was created by the program. If there is SoX installed then it will run further. "
 let ts :: Maybe String
ts = String -> Maybe String
showE String
"sox"
 if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
ts
   then String -> String -> String -> IO ()
rawToSoundFile String
zs String
nameSF (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
ts)
   else IO ()
printInfoF

-- | Is used to retriev the user-defined file name for the record.
recFileName :: IO String
recFileName :: IO String
recFileName = do
  String -> IO ()
putStrLn String
"Please, specify the name of the resulting sound file. Please, do NOT use '}' character and space or control characters!"
  String
nameOfSoundFile <- IO String
getLine
  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 String
forall (m :: * -> *) a. Monad m => a -> m a
return String
nameSF

getCtrl :: String -> Bool -> IO String
getCtrl :: String -> Bool -> IO String
getCtrl String
zs Bool
onepass = do
  String
xs <- if Bool
onepass then IO String
getLine else IO String
getContents
  let ys :: String
ys = Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
nSymbols (String -> Int) -> (String -> String) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
zs) String
xs
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
ys

recFNAndCtrl :: String -> Bool -> FilePath -> Int -> IO String
recFNAndCtrl :: String -> Bool -> String -> Int -> IO String
recFNAndCtrl String
zs Bool
onepass String
file Int
n
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = IO String
recFileName
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = String -> IO String
readFile String
file
  | Bool
otherwise = String -> Bool -> IO String
getCtrl String
zs Bool
onepass

nameAndControl :: String -> Bool -> FilePath -> [Int] -> IO [String]
nameAndControl :: String -> Bool -> String -> [Int] -> IO [String]
nameAndControl String
zs Bool
onepass String
file = (Int -> IO String) -> [Int] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Bool -> String -> Int -> IO String
recFNAndCtrl String
zs Bool
onepass String
file)

-- | Converts RAW sound to the sound file of the needed format in the current directory accordingly to the 'genControl' for the first 'String' argument.
-- Is used internally in the 'workWithInput'.
rawToSoundFile :: String -> String -> FilePath -> IO ()
rawToSoundFile :: String -> String -> String -> IO ()
rawToSoundFile String
zs String
nameSF String
executablePath
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
zs = do
     String -> [String] -> IO ()
callProcess String
executablePath [String
"-r22050",String
"-c1", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".ul", String
"-r22050",String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".wav"]
     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
".ul"
  | Bool
otherwise = 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)
forall a b. (a -> b) -> a -> b
$ String
zs
     String -> [String] -> IO ()
callProcess String
executablePath (if (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
ws String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
".wav" then [String
"-r22050",String
"-c1", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".ul", String
"-r22050",(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] else [String
"-r22050",String
"-c1", String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".ul", (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 -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
nameSF String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".ul"

-- | Prints informational message about ending of the possible for the given data program operation on sound files. Is used internally in the 'workWithInput'.
-- Is used internally in the 'workWithInput'.
printInfoF :: IO ()
printInfoF :: IO ()
printInfoF = do
  String -> IO ()
putStr String
"You have a resulting file in a raw PCM format with bitrate 22050 Hz and 1 channel (mono) in the .ul format. "
  String -> IO ()
putStr String
"You can further process it by yourself manually, otherwise, please, install SoX executable in the directory mentioned in the variable PATH and then run: "
  String -> IO ()
putStrLn String
"\"Path_to_the_SoX_executable\" -r22050 -c1 name_of_the_file_in_ul_format_with_new._prefix name_of_the_file_in_wav_format_with_new._prefix in the terminal."