-- |
-- Module      :  UkrainianLControl
-- 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 UkrainianLControl (
  -- * Control the program
  genControl,
  -- * Security and Limits
  nSymbols
) where

import Data.Char (isDigit)
import qualified Data.Vector as V (generate)
import CaseBi (getBFst')

-- | Function that converts the first digit in the command line argument (starting the argument or being the second one after the letter character) given, 
-- which is a digit in the range @[0..9]@ (providing an ascending approximately exponential scale with a basis of 10 starting from 2 and ending at 1000000001), 
-- to the upper bound of number of symbols that the 'main' function of the @mmsyn6ukr@ executable reads from the 'System.IO.stdin' for sounding.
-- The default resulting value (no input) is 31416. If there is another first command line argument then the program 
-- terminates with the informational message. Using the command line argument is done for the security reasons: 
-- because of performative writing to the resulting file(s) there is a need to limit the used memory. For most cases it is
-- enough to use the default value. If you have enough resources and a large Ukrainian text amount then specify the higher values 
-- (5 or a greater one). 
nSymbols :: String -> Int
nSymbols :: String -> Int
nSymbols String
xs | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = Int
31416::Int
            | Bool
otherwise = (Int, Vector (Int, Int)) -> Int -> Int
forall a b. Ord a => (b, Vector (a, b)) -> a -> b
getBFst' (Int
31416::Int, Int -> (Int -> (Int, Int)) -> Vector (Int, Int)
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
10 (\Int
n -> (Int
n, (Int
10Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)::Int))) (let temp :: Int
temp = String -> Int
forall a. Read a => String -> a
read String
xs::Int in if Int
temp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 Bool -> Bool -> Bool
&& Int
temp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                            then Int
temp 
                            else String -> Int
forall a. HasCallStack => String -> a
error String
"Please, specify a digit as a command line argument for the program!")

-- | Function that prepares arguments for the controlling functions for the executable @mmsyn6ukr@. It takes a first command line argument and makes 
-- an analysis to produce a set of String. The first resulting String is an argument to 'nSymbols' function, the first in the inner tuple is an argument
-- to the compression level for the comressed formats and the last one is the resulting file extension. The default value (no command line arguments) is
-- @("", ("", ".wav"))@. Please, specify the command line argument (if needed) in the form \"ABC\""
-- where A is either a letter \'f\', \'o\', \'w\' or a digit and B and C are both digits (or something equivalent, see below). 
-- 
-- Their meaning:
-- 
-- A:
-- 
-- \'f\' -> native FLAC format with compression from 0 (least) to 8 (best compression ratio) specified by the third characters; \'9\' is equivalent to \'8\'. This format is optional so, 
-- please, check whether it is supported by your SoX binaries. If no, install the SoX with support for the format. For more information, please, refer to the @sox@ documentation.
-- 
-- \'o\' -> Ogg Vorbis format with compression from -1 (best) to 10 (least) specified by the characters after the first two characters. The default value is "-1". This format is optional 
-- so, please, check whether it is supported by your SoX binaries. If no, install the SoX with support for the format. For more information, please, refer to the @sox@ documentation.
-- 
-- \'w\' -> WAV format with two options for rate - 11025 Hz if the third character is less than '5' and greater than '0' and otherwise 22050 Hz (the default one also for no command line arguments). 
-- 
-- If A is a digit, then it is used accordingly to 'nSymbols' function and SoX (if properly installed) quickly converts the .raw file to the default .wav with 22050 Hz rate.
-- 
-- To obtain the best compression ratio, please specify something like \"o9-1\" or \"o5-1\" (or similar). For the best lossless compression - \"f98\" or \"f58\" (or similar). 
-- 
-- For more information, please, see the @sox@ manuals (e. g. for @soxformat@).
genControl :: String -> (String, (String, String))
genControl :: String -> (String, (String, String))
genControl (Char
x:String
xs) | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'f' = ([String -> Char
forall a. [a] -> a
head String
xs], (String
"-C" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String
forall a. [a] -> [a]
tail String
xs) String
"9" Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT) Bool -> Bool -> Bool
&& (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String
forall a. [a] -> [a]
tail String
xs) String
"0" Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) then Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
xs else String
"8"), String
".flac"))
                  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'o' = ([String -> Char
forall a. [a] -> a
head String
xs], (String
"-C" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if ((String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String
forall a. [a] -> [a]
tail String
xs) String
"9" Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT) Bool -> Bool -> Bool
&& (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String
forall a. [a] -> [a]
tail String
xs) String
"0" Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT)) then Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
xs else if (String -> String
forall a. [a] -> [a]
tail String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"10") then String
"10" else String
"-1"), String
".ogg"))
                  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w' = ([String -> Char
forall a. [a] -> a
head String
xs], (String
"-r" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if ((String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String
forall a. [a] -> [a]
tail String
xs) String
"4" Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT) Bool -> Bool -> Bool
&& (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String
forall a. [a] -> [a]
tail String
xs) String
"0" Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT)) then String
"11025" else String
"22050"), String
".wav"))
                  | Char -> Bool
isDigit Char
x = ([Char
x], (String
"", String
".wav"))
                  | Bool
otherwise = (String
"", (String
"", String
".wav"))
genControl [] = (String
"", (String
"", String
".wav"))