{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}


-- |
-- Module      :  Phonetic.Languages.Simple
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
-- The library functions for the lineVariantsG3 executable. Since 0.4.0.0 version it supports printing of the informational
-- messages both in English and Ukrainian. Since the 0.13.0.0 version there is the possibility to provide custom durations
-- instead of the default predefined ones.

module Phonetic.Languages.Simple where

import Phonetic.Languages.Array.Ukrainian.Common
import Phonetic.Languages.Parsing
import Numeric
import Languages.UniquenessPeriods.Array.Constraints.Encoded (decodeLConstraints,readMaybeECG)
import GHC.Arr
import CaseBi.Arr (getBFstLSorted')
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Basis
import Phonetic.Languages.Simplified.DataG.Partir
import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI)
import Phonetic.Languages.Simplified.StrictVG.Base
import Data.Char (isDigit,isAlpha,isLetter)
import qualified Data.List  as L (span,sort,zip4,isPrefixOf,nub,sortBy,intersperse)
import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2
import Phonetic.Languages.Permutations.Arr
import Phonetic.Languages.Permutations.ArrMini
import Phonetic.Languages.Permutations.ArrMini1
import Data.SubG hiding (takeWhile,dropWhile)
import Data.Maybe
import Data.MinMax.Preconditions
import Text.Read (readMaybe)
import Phonetic.Languages.Simplified.DeEnCoding
import Phonetic.Languages.Simplified.SimpleConstraints
import Interpreter.StringConversion
import Melodics.Ukrainian.ArrInt8 (Sound8)
import Phonetic.Languages.Ukrainian.PrepareText (prepareTuneTextMN,isSpC,isUkrainianL)
import Phonetic.Languages.Simplified.Array.Ukrainian.ReadProperties
import Phonetic.Languages.Permutations.Represent
import Languages.Ukrainian.Data
import Phonetic.Languages.Emphasis
import Data.List (sortBy)

forMultiplePropertiesF :: [String] -> [(String,[String])]
forMultiplePropertiesF :: [String] -> [(String, [String])]
forMultiplePropertiesF (String
xs:[String]
xss)
 | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isAlpha String
xs = (String
xs,[String]
yss)(String, [String]) -> [(String, [String])] -> [(String, [String])]
forall a. a -> [a] -> [a]
:[String] -> [(String, [String])]
forMultiplePropertiesF [String]
zss
 | Bool
otherwise = []
     where l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> ([String] -> [String]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ [String]
xss
           ([String]
yss,[String]
zss) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
l [String]
xss
forMultiplePropertiesF [String]
_ = []

{-| Is used to organize the most complex processment -- for multiple sources and probably recursively.
-}
generalProc3G
 :: FilePath -- ^ Whether to use the own provided durations from the file specified here.
 -> PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> [String]
 -> String -- ^ If empty, the function is just 'generalProc2G' with the arguments starting from the first 'Bool' here.
 -> Int
 -> Bool
 -> Bool
 -> FilePath
 -> Bool
 -> Bool
 -> [String]
 -> Coeffs2
 -> Coeffs2
 -> [String]
 -> Bool
 -> Bool -- ^ Whether to use volatile string weights
 -> Int -- ^ Number of sets of volatile string weights for every processed line. Is used when the previous one is 'True'
 -> Int -- ^ Whether to print more verbose information in the output with sorting in some way
 -> IO ()
generalProc3G :: String
-> PermutationsType
-> [String]
-> String
-> Int
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc3G String
fileDu PermutationsType
pairwisePermutations [String]
textProcessmentFss String
textProcessment0 Int
textProcessment1 Bool
recursiveMode Bool
nativeUkrainian String
toFileMode1 Bool
interactiveP Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW Bool
syllables Int
syllablesVs Int
verbose = do
  [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs <- String -> IO [[[[Sound8]]] -> [[Double]]]
readSyllableDurations String
fileDu
  [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> [String]
-> String
-> Int
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t, Eq a, Num a) =>
[[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> t String
-> t a
-> a
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc3G' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations [String]
textProcessmentFss String
textProcessment0 Int
textProcessment1 Bool
recursiveMode Bool
nativeUkrainian String
toFileMode1 Bool
interactiveP Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW Bool
syllables Int
syllablesVs Int
verbose
    where generalProc3G' :: [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> t String
-> t a
-> a
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc3G' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations t String
textProcessmentFss t a
textProcessment0 a
textProcessment1 Bool
recursiveMode Bool
nativeUkrainian String
toFileMode1 Bool
interactiveP Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW Bool
syllables Int
syllablesVs Int
verbose
            | t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
textProcessment0 = [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian String
toFileMode1 Bool
interactiveP Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW Bool
syllables Int
syllablesVs Int
verbose
            | t String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t String
textProcessmentFss = (Integer -> IO ()) -> [Integer] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Integer
_ -> do  -- interactive training mode
                 String -> IO ()
putStrLn (String -> IO ()) -> (Bool -> String) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
messageInfo Int
7 (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
                 String
lineA <- IO String
getLine
                 [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian String
toFileMode1 Bool
interactiveP Bool
jstL0 ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
mightNotUkrWord String
lineA [String]
args0) Coeffs2
coeffs Coeffs2
coeffsWX ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
mightNotUkrWord String
lineA [String]
args) Bool
lstW  Bool
syllables Int
syllablesVs Int
verbose) [Integer
0..]
            | Bool
otherwise =
                 (String -> IO ()) -> t String -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
js -> do
                  let !kss :: [String]
kss = String -> [String]
lines String
js
                  if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then do
                    let !wss :: [String]
wss
                         | a
textProcessment1 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
10,a
20,a
30,a
40,a
50,a
60,a
70,a
80,a
90] = [String]
kss
                         | Bool
otherwise = Int -> Int -> String -> [String]
prepareTuneTextMN Int
m Int
1 (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
kss
                    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
tss -> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian String
toFileMode1 Bool
interactiveP Bool
jstL0 ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
mightNotUkrWord String
tss [String]
args0) Coeffs2
coeffs Coeffs2
coeffsWX
                      ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
mightNotUkrWord String
tss [String]
args) Bool
lstW Bool
syllables Int
syllablesVs Int
verbose) [String]
wss
                  else do
                    let !wss :: [String]
wss
                         | a
textProcessment1 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
20,a
30,a
40,a
50,a
60,a
70] = [String]
kss
                         | Bool
otherwise = Int -> Int -> String -> [String]
prepareTuneTextMN (if a
textProcessment1 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
21,a
31,a
41,a
51,a
61] then Int
m else Int
7) Int
1 (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
kss
                    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
tss -> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian String
toFileMode1 Bool
interactiveP Bool
jstL0 ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
mightNotUkrWord String
tss [String]
args0) Coeffs2
coeffs Coeffs2
coeffsWX
                      ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
mightNotUkrWord String
tss [String]
args) Bool
lstW Bool
syllables Int
syllablesVs Int
verbose) [String]
wss) t String
textProcessmentFss
          m :: Int
m = if Int
textProcessment1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
10 Bool -> Bool -> Bool
|| Int
textProcessment1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
11 then Int
10 else Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
textProcessment1 Int
10

{-| If 'False' then it might be the Ukrainian word in the phonetic languages approach. If 'True', it is not.
Is an example of the predicate inside the 'fullArgsConvertTextual' function for the Ukrainian language.
-}
mightNotUkrWord :: String -> Bool
mightNotUkrWord :: String -> Bool
mightNotUkrWord String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ts Bool -> Bool -> Bool
|| String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" = Bool
True
 | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isAlpha String
us = Bool
True
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isUkrainianN) String
us) = Bool
False
 | Bool
otherwise = Bool
True
     where (String
ts,String
us) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span Char -> Bool
isUkrainianN String
xs
{-# INLINE mightNotUkrWord #-}

-- | Is taken from the @mmsyn6ukr@ package version 0.8.1.0 so that the amount of dependencies are reduced (and was slightly modified).
isUkrainianN :: Char -> Bool
isUkrainianN Char
x = Char -> Bool
isUkrainianL Char
x Bool -> Bool -> Bool
|| Char -> Bool
isSpC Char
x

{-|
@ since 0.3.0.0
Is used to do general processment.
@ since 0.5.0.0
The meaning of the first command line argument (and 'Coeffs2' here everywhere in the module)
depends on the 'String' argument -- whether it starts with \'w\', \'x\' or otherwise. In the first case it represents
the k1 and k2 coefficients (default ones equal to 2.0 and 0.125) for the functions from the Rhythmicity.TwoFourth module.
Otherwise, it is used for the functions to specify the level of emphasizing the two-based and three-based periods
(the default values here are 1.0 both).
@ since 0.6.0.0
Changed the arguments signing so that capital letters changed to the small ones, double ++ changed to just singular +.
@ since 0.9.0.0
Added a new argument to control whether to use interactive recursive mode.

-}
generalProc2G
 :: [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
 -> PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> Bool
 -> Bool
 -> FilePath
 -> Bool
 -> Bool
 -> [String]
 -> Coeffs2
 -> Coeffs2
 -> [String]
 -> Bool
 -> Bool -- ^ Whether to use volatile string weights
 -> Int -- ^ Number of sets of volatile string weights for every processed line. Is used when the previous one is 'True'
 -> Int 
 -> IO ()
generalProc2G :: [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian String
toFile1 Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | [String] -> Bool
variations [String]
args = do
    let !zsss :: [[String]]
zsss = [String] -> [[String]]
transformToVariations [String]
args
    [(ReadyForConstructionUkr, String)]
variantsG <- ([String] -> IO (ReadyForConstructionUkr, String))
-> [[String]] -> IO [(ReadyForConstructionUkr, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[String]
xss -> [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
generalProc2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [] PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
xss Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose) [[String]]
zsss
    if Bool
interactive then do 
           (if Bool
recursiveMode then [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> ((ReadyForConstructionUkr, String) -> String)
-> [(ReadyForConstructionUkr, String)]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [] PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0  [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (ReadyForConstructionUkr -> String
showR (ReadyForConstructionUkr -> String)
-> ((ReadyForConstructionUkr, String) -> ReadyForConstructionUkr)
-> (ReadyForConstructionUkr, String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionUkr, String) -> ReadyForConstructionUkr
forall a b. (a, b) -> a
fst) [(ReadyForConstructionUkr, String)]
variantsG [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
           else Bool
-> ((ReadyForConstructionUkr, String) -> String)
-> [(ReadyForConstructionUkr, String)]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
Bool
-> (a -> String)
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResult Bool
nativeUkrainian (ReadyForConstructionUkr -> String
showR (ReadyForConstructionUkr -> String)
-> ((ReadyForConstructionUkr, String) -> ReadyForConstructionUkr)
-> (ReadyForConstructionUkr, String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionUkr, String) -> ReadyForConstructionUkr
forall a b. (a, b) -> a
fst) [(ReadyForConstructionUkr, String)]
variantsG Bool
syllables Int
syllablesVs) IO (ReadyForConstructionUkr, String)
-> ((ReadyForConstructionUkr, String) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ReadyForConstructionUkr
rs,String
cs) ->
            case String
toFile1 of
               String
"" -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               ~String
fileName -> String -> String -> IO ()
appendFile String
fileName (String -> ReadyForConstructionUkr -> String
convFSL String
cs ReadyForConstructionUkr
rs String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding)
    else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () 
 | Bool
otherwise = [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
generalProc2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [] PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose IO (ReadyForConstructionUkr, String)
-> ((ReadyForConstructionUkr, String) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \(ReadyForConstructionUkr
rs,String
cs) ->
      case String
toFile1 of
       String
"" -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       ~String
fileName -> String -> String -> IO ()
appendFile String
fileName (String -> ReadyForConstructionUkr -> String
convFSL String
cs ReadyForConstructionUkr
rs String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding)

-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
generalProc2
 :: [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
 -> [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the volatile syllables durations
 -> PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> [String]
 -> Coeffs2
 -> Coeffs2
 -> [String]
 -> Bool
 -> Bool -- ^ Whether to use volatile string weights
 -> Int -- ^ Number of sets of volatile string weights for every processed line. Is used when the previous one is 'True'
 -> Int
 -> IO (ReadyForConstructionUkr, String)
generalProc2 :: [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
generalProc2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose = do
 let !argMss :: [(String, [String])]
argMss = Int -> [(String, [String])] -> [(String, [String])]
forall a. Int -> [a] -> [a]
take Int
5 ([(String, [String])] -> [(String, [String])])
-> ([String] -> [(String, [String])])
-> [String]
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [String]) -> Bool)
-> [(String, [String])] -> [(String, [String])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, [String]) -> Bool) -> (String, [String]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [String]) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([(String, [String])] -> [(String, [String])])
-> ([String] -> [(String, [String])])
-> [String]
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(String, [String])]
forMultiplePropertiesF ([String] -> [(String, [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]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+m") ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-m") ([String] -> [(String, [String])])
-> [String] -> [(String, [String])]
forall a b. (a -> b) -> a -> b
$ [String]
args0
 if [(String, [String])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [String])]
argMss then do
  let (![String]
numericArgs,![String]
textualArgs) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ [String]
args
      !bs :: String
bs = [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]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> String -> [String]
prepareTuneTextMN (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then Int
10 else Int
7) Int
1 (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
textualArgs
      !xs :: ReadyForConstructionUkr
xs = String -> ReadyForConstructionUkr
Str String
bs
      !l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
bs
      !argCs :: [EncodedCnstrs]
argCs = [Maybe EncodedCnstrs] -> [EncodedCnstrs]
forall a. [Maybe a] -> [a]
catMaybes ((String -> Maybe EncodedCnstrs)
-> [String] -> [Maybe EncodedCnstrs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> Maybe EncodedCnstrs
readMaybeECG (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([String] -> [Maybe EncodedCnstrs])
-> ([String] -> [String]) -> [String] -> [Maybe EncodedCnstrs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool -> String
showB Int
l Bool
lstW2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([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]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+a") ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-a") ([String] -> [Maybe EncodedCnstrs])
-> [String] -> [Maybe EncodedCnstrs]
forall a b. (a -> b) -> a -> b
$ [String]
args0)
      !arg0 :: String
arg0 = [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]
numericArgs
      !numberI :: Int
numberI = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([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]
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]
numericArgs)::Maybe Int)
      !choice :: String
choice = [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]
textualArgs
      !intervalNmbrs :: [Int]
intervalNmbrs = (\[Int]
zs -> if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
zs then [Int
numberI] else [Int] -> [Int]
forall a. Eq a => [a] -> [a]
L.nub [Int]
zs) ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
numberI) ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\String
t -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
numberI (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
t::Maybe Int)) ([String] -> [Int]) -> ([String] -> [String]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> [Int]) -> [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ [String]
numericArgs
  (if Bool
syllables then do Int
-> Bool
-> String
-> IO
     ([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
      ReadyForConstructionUkr)
weightsString3NIO Int
syllablesVs ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice) String
bs else ([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
 ReadyForConstructionUkr)
-> IO
     ([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
      ReadyForConstructionUkr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],String -> ReadyForConstructionUkr
Str [])) IO
  ([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
   ReadyForConstructionUkr)
-> (([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
     ReadyForConstructionUkr)
    -> IO (ReadyForConstructionUkr, String))
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \([[[Sound8]]]
syllDs,[[[[Sound8]]] -> [[Double]]]
syllableDs,ReadyForConstructionUkr
readys) -> do 
   if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then let !frep20 :: FuncRep2 ReadyForConstructionUkr Double Double
frep20 = Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double Double
forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double -> Double
forall a. a -> a
id (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w') String
choice then Coeffs2
coeffsWX else  Coeffs2
coeffs) String
choice String
bs
                                 !wwss :: [Result2 ReadyForConstructionUkr Double Double]
wwss = (Result2 ReadyForConstructionUkr Double Double
-> [Result2 ReadyForConstructionUkr Double Double]
-> [Result2 ReadyForConstructionUkr Double Double]
forall a. a -> [a] -> [a]
:[]) (Result2 ReadyForConstructionUkr Double Double
 -> [Result2 ReadyForConstructionUkr Double Double])
-> (ReadyForConstructionUkr
    -> Result2 ReadyForConstructionUkr Double Double)
-> ReadyForConstructionUkr
-> [Result2 ReadyForConstructionUkr Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncRep2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
-> Result2 ReadyForConstructionUkr Double Double
forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep20 (ReadyForConstructionUkr
 -> [Result2 ReadyForConstructionUkr Double Double])
-> ReadyForConstructionUkr
-> [Result2 ReadyForConstructionUkr Double Double]
forall a b. (a -> b) -> a -> b
$ ReadyForConstructionUkr
xs in
    case Bool
recursiveMode of
      Bool
True -> [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (String -> ReadyForConstructionUkr -> String
convFSL String
bs (ReadyForConstructionUkr -> String)
-> (Result2 ReadyForConstructionUkr Double Double
    -> ReadyForConstructionUkr)
-> Result2 ReadyForConstructionUkr Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
wwss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
      Bool
_ -> if Bool
interactive then Bool
-> (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
Bool
-> (a -> String)
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResult Bool
nativeUkrainian (String -> ReadyForConstructionUkr -> String
convFSL String
bs (ReadyForConstructionUkr -> String)
-> (Result2 ReadyForConstructionUkr Double Double
    -> ReadyForConstructionUkr)
-> Result2 ReadyForConstructionUkr Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
wwss Bool
syllables Int
syllablesVs else Bool
-> String
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, String)
print1el Bool
jstL0 String
choice [Result2 ReadyForConstructionUkr Double Double]
wwss
   else do
    let !subs :: [String]
subs = String -> String -> [String]
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG String
" " String
bs -- Probably, here it can just 'words' be used.
    if [EncodedCnstrs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EncodedCnstrs]
argCs then let !perms :: [Array Int Int]
perms
                             | PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 = Int -> [Array Int Int]
genPairwisePermutationsLN Int
l
                             | PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
1 = Int -> [Array Int Int]
genElementaryPermutationsLN1 Int
l
                             | Bool
otherwise = Int -> [Array Int Int]
genPermutationsL Int
l in do
          [Result2 ReadyForConstructionUkr Double Double]
temp <- [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [String]
subs ([Int]
intervalNmbrs, String
arg0, Int
numberI, String
choice) Bool
syllables Int
syllablesVs 
          if Bool
recursiveMode then [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (String -> ReadyForConstructionUkr -> String
convFSL String
bs (ReadyForConstructionUkr -> String)
-> (Result2 ReadyForConstructionUkr Double Double
    -> ReadyForConstructionUkr)
-> Result2 ReadyForConstructionUkr Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
          else if Bool
interactive then Bool
-> (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
Bool
-> (a -> String)
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResult Bool
nativeUkrainian (String -> ReadyForConstructionUkr -> String
convFSL String
bs (ReadyForConstructionUkr -> String)
-> (Result2 ReadyForConstructionUkr Double Double
    -> ReadyForConstructionUkr)
-> Result2 ReadyForConstructionUkr Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp Bool
syllables Int
syllablesVs else Bool
-> String
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, String)
print1el Bool
jstL0 String
choice [Result2 ReadyForConstructionUkr Double Double]
temp
    else do
     String
correct <- Bool -> String -> IO String
printWarning Bool
nativeUkrainian String
bs
     if String
correct String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"n" then String -> IO ()
putStrLn (Int -> Bool -> String
messageInfo Int
1 Bool
nativeUkrainian) IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str [],[]) -- for the multiple variations mode (with curly brackets and slash in the text) the program does not stop here, but the variation is made empty and is proposed further as a variant.
     else let !perms :: [Array Int Int]
perms = [EncodedCnstrs] -> [Array Int Int] -> [Array Int Int]
forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
[EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints [EncodedCnstrs]
argCs ([Array Int Int] -> [Array Int Int])
-> (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 then Int -> [Array Int Int]
genPairwisePermutationsLN else if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
0 then Int -> [Array Int Int]
genPermutationsL else Int -> [Array Int Int]
genElementaryPermutationsLN1) (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall a b. (a -> b) -> a -> b
$ Int
l in do
          [Result2 ReadyForConstructionUkr Double Double]
temp <- [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [String]
subs ([Int]
intervalNmbrs, String
arg0, Int
numberI, String
choice) Bool
syllables Int
syllablesVs 
          if Bool
recursiveMode then [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (String -> ReadyForConstructionUkr -> String
convFSL String
bs (ReadyForConstructionUkr -> String)
-> (Result2 ReadyForConstructionUkr Double Double
    -> ReadyForConstructionUkr)
-> Result2 ReadyForConstructionUkr Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
          else if Bool
interactive then Bool
-> (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
Bool
-> (a -> String)
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResult Bool
nativeUkrainian (String -> ReadyForConstructionUkr -> String
convFSL String
bs (ReadyForConstructionUkr -> String)
-> (Result2 ReadyForConstructionUkr Double Double
    -> ReadyForConstructionUkr)
-> Result2 ReadyForConstructionUkr Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp Bool
syllables Int
syllablesVs else Bool
-> String
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, String)
print1el Bool
jstL0 String
choice [Result2 ReadyForConstructionUkr Double Double]
temp
--------------------------------------------------------
  else do
   let !choices :: [String]
choices = ((String, [String]) -> String) -> [(String, [String])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> String
forall a b. (a, b) -> a
fst [(String, [String])]
argMss
       !numericArgss :: [[String]]
numericArgss = ((String, [String]) -> [String])
-> [(String, [String])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> [String]
forall a b. (a, b) -> b
snd [(String, [String])]
argMss
       !arg0s :: [String]
arg0s = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([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]]
numericArgss
       !numberIs :: [Int]
numberIs = ([String] -> Int) -> [[String]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\[String]
ts -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([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]
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]
ts)::Maybe Int)) [[String]]
numericArgss
       !intervalNmbrss :: [[Int]]
intervalNmbrss = ([String] -> [Int]) -> [[String]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (\[String]
us -> let !numberI :: Int
numberI = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([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]
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]
us)::Maybe Int) in
         (\[Int]
zs -> if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
zs then [Int
numberI] else [Int] -> [Int]
forall a. Eq a => [a] -> [a]
L.nub [Int]
zs) ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
numberI) ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\String
t -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
numberI (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
t::Maybe Int)) ([String] -> [Int]) -> ([String] -> [String]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> [Int]) -> [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ [String]
us) ([[String]] -> [[Int]]) -> [[String]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [[String]]
numericArgss
       !argsZipped :: [([Int], String, Int, String)]
argsZipped = [[Int]]
-> [String] -> [Int] -> [String] -> [([Int], String, Int, String)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
L.zip4 [[Int]]
intervalNmbrss [String]
arg0s [Int]
numberIs [String]
choices
       !bs :: String
bs = [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]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> String -> [String]
prepareTuneTextMN (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then Int
10 else Int
7) Int
1 (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args
       !xs :: ReadyForConstructionUkr
xs = String -> ReadyForConstructionUkr
Str String
bs
       !l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
bs
       !argCs :: [EncodedCnstrs]
argCs = [Maybe EncodedCnstrs] -> [EncodedCnstrs]
forall a. [Maybe a] -> [a]
catMaybes ((String -> Maybe EncodedCnstrs)
-> [String] -> [Maybe EncodedCnstrs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> Maybe EncodedCnstrs
readMaybeECG (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([String] -> [Maybe EncodedCnstrs])
-> ([String] -> [String]) -> [String] -> [Maybe EncodedCnstrs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool -> String
showB Int
l Bool
lstW2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([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]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+a") ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-a") ([String] -> [Maybe EncodedCnstrs])
-> [String] -> [Maybe EncodedCnstrs]
forall a b. (a -> b) -> a -> b
$ [String]
args0)
   ([[[Sound8]]]
syllDs,[[[[Sound8]]] -> [[Double]]]
syllableDs,ReadyForConstructionUkr
readys) <- do if Bool
syllables then Int
-> Bool
-> String
-> IO
     ([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
      ReadyForConstructionUkr)
weightsString3NIO Int
syllablesVs ((Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Bool -> Bool
forall a. a -> a
id ((String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a')) [String]
choices)) String
bs else ([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
 ReadyForConstructionUkr)
-> IO
     ([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
      ReadyForConstructionUkr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],[[[Sound8]]] -> ReadyForConstructionUkr
FSL [])
   if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then let !frep20 :: FuncRep2 ReadyForConstructionUkr Double Double
frep20 = Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double Double
forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') (String -> Bool) -> ([String] -> String) -> [String] -> Bool
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 b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
choices then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double -> Double
forall a. a -> a
id Coeffs2
coeffs ([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]
choices) String
bs
                                 !wwss :: [Result2 ReadyForConstructionUkr Double Double]
wwss = (Result2 ReadyForConstructionUkr Double Double
-> [Result2 ReadyForConstructionUkr Double Double]
-> [Result2 ReadyForConstructionUkr Double Double]
forall a. a -> [a] -> [a]
:[]) (Result2 ReadyForConstructionUkr Double Double
 -> [Result2 ReadyForConstructionUkr Double Double])
-> (ReadyForConstructionUkr
    -> Result2 ReadyForConstructionUkr Double Double)
-> ReadyForConstructionUkr
-> [Result2 ReadyForConstructionUkr Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncRep2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
-> Result2 ReadyForConstructionUkr Double Double
forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep20 (ReadyForConstructionUkr
 -> [Result2 ReadyForConstructionUkr Double Double])
-> ReadyForConstructionUkr
-> [Result2 ReadyForConstructionUkr Double Double]
forall a b. (a -> b) -> a -> b
$ ReadyForConstructionUkr
xs in
     case Bool
recursiveMode of
       Bool
True -> [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if Bool
syllables then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (String -> ReadyForConstructionUkr -> String
convFSL String
bs (ReadyForConstructionUkr -> String)
-> (Result2 ReadyForConstructionUkr Double Double
    -> ReadyForConstructionUkr)
-> Result2 ReadyForConstructionUkr Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
wwss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
       Bool
_ -> if Bool
interactive then Bool
-> (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
Bool
-> (a -> String)
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResult Bool
nativeUkrainian (String -> ReadyForConstructionUkr -> String
convFSL String
bs (ReadyForConstructionUkr -> String)
-> (Result2 ReadyForConstructionUkr Double Double
    -> ReadyForConstructionUkr)
-> Result2 ReadyForConstructionUkr Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
wwss Bool
syllables Int
syllablesVs else Bool
-> String
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, String)
print1el Bool
jstL0 ([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]
choices) [Result2 ReadyForConstructionUkr Double Double]
wwss
   else do
    let !subs :: [String]
subs = String -> String -> [String]
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG String
" " String
bs
    if [EncodedCnstrs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EncodedCnstrs]
argCs then let !perms :: [Array Int Int]
perms
                             | PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 = Int -> [Array Int Int]
genPairwisePermutationsLN Int
l
                             | PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
1 = Int -> [Array Int Int]
genElementaryPermutationsLN1 Int
l
                             | Bool
otherwise = Int -> [Array Int Int]
genPermutationsL Int
l in
       [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [([Int], String, Int, String)]
-> [Array Int Int]
-> [String]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
generalProcMMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
syllableDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [([Int], String, Int, String)]
argsZipped [Array Int Int]
perms [String]
subs [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
    else do
     String
correct <- Bool -> String -> IO String
printWarning Bool
nativeUkrainian String
bs
     if String
correct String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"n" then String -> IO ()
putStrLn (Int -> Bool -> String
messageInfo Int
1 Bool
nativeUkrainian) IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str [],[]) -- for the multiple variations mode (with curly brackets and slash in the text) the program does not stop here, but the variation is made empty and is proposed further as a variant.
     else let !perms :: [Array Int Int]
perms = [EncodedCnstrs] -> [Array Int Int] -> [Array Int Int]
forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
[EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints [EncodedCnstrs]
argCs ([Array Int Int] -> [Array Int Int])
-> (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 then Int -> [Array Int Int]
genPairwisePermutationsLN else if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
0 then Int -> [Array Int Int]
genPermutationsL else Int -> [Array Int Int]
genElementaryPermutationsLN1) (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall a b. (a -> b) -> a -> b
$ Int
l in [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [([Int], String, Int, String)]
-> [Array Int Int]
-> [String]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
generalProcMMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
syllableDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [([Int], String, Int, String)]
argsZipped [Array Int Int]
perms [String]
subs [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose

{-|
-- @ since 0.4.0.0
Function provides localized message information. If the 'Bool' argument is 'True' then it gives result in Ukrainian, otherwise -- in English.
-}
messageInfo :: Int -> Bool -> String
messageInfo :: Int -> Bool -> String
messageInfo Int
n Bool
True
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String
"Ви зупинили програму, будь ласка, якщо потрібно, виконайте її знову з кращими аргументами. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = String
"Будь ласка, вкажіть варіант (який Ви бажаєте, щоб він став результуючим рядком) за його номером. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = String
"Будь ласка, перевірте, чи рядок нижче відповідає і узгоджується з обмеженнями, які Ви вказали між +a та -a опціями. Перевірте також, чи Ви вказали \"+b\" чи \"+bl\" опцію(ї). Якщо введені опції та аргументи не узгоджені з виведеним далі рядком, тоді введіть далі \"n\", натисніть Enter і опісля запустіть програму на виконання знову з кращими аргументами. " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"Якщо рядок узгоджується з Вашим вводом між +a та -a, тоді просто натисніть Enter, щоб продовжити далі. " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = String
"Було задано недостатньо інформації для продовження обчислювального процесу "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = String
"(/ Ви вказали властивості(ість) та діапазон(и) для них такі, що для даних слів та їх сполучень варіантів немає. Спробуйте змінити параметри виклику програми (бібліотеки) /)"
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = String
"Якщо бажаєте запустити програму (функцію) рекурсивно, змінюючи сполучення слів та букв, введіть тут закодований рядок інтерпретатора. Якщо бажаєте не використовувати програму (функцію) рекурсивно, просто натисніть Enter. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = String
"Введіть, будь ласка, рядок слів для аналізу. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = String
"Введіть, будь ласка, кількість слів чи їх сполучень, які програма розглядатиме як один рядок для аналізу. "
 | Bool
otherwise = String
"Ви вказали лише один варіант властивостей. "
messageInfo Int
n Bool
False
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String
"You stopped the program, please, if needed, run it again with better arguments. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = String
"Please, specify the variant which you would like to become the resulting string by its number. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = String
"Please, check whether the line below corresponds and is consistent with the constraints you have specified between the +a and -a options. Check also whether you have specified the \"+b\" or \"+bl\" option(s). If it is inconsistent then enter further \"n\", press Enter and then run the program again with better arguments. " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"If the line is consistent with your input between +a and -a then just press Enter to proceed further. " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = String
"No data has been specified to control the computation process. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = String
"(/ You have specified properties / property and the range(s) so that for the words and their concatenations there are no variants available. Try to change the call parameters /)"
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = String
"If you would like to run the program (call the function) recursively with changes for the words or letter connections then, please, enter here the encoded string of the interpreter. If you would NOT like to use it recursively, then just press Enter."
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = String
"Please, input the text line for analysis. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = String
"Please, input the number of words or their concatenations that the program takes as one line for analysis. "
 | Bool
otherwise = String
"You have specified just one variant of the properties. "

-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
-- @ since 0.8.0.0 The function has also the option for the empty result.
interactivePrintResult
 :: Bool
 -> (a -> String)
 -> [a]
 -> Bool -- ^ Whether to use volatile string weights
 -> Int -- ^ Number of sets of volatile string weights for every processed line. Is used when the previous one is 'True'
 -> IO (ReadyForConstructionUkr, String)
interactivePrintResult :: Bool
-> (a -> String)
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResult Bool
nativeUkrainian a -> String
f [a]
xss Bool
syllables Int
syllablesVs
  | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xss = (String -> IO ()
putStrLn (String -> IO ()) -> (Bool -> String) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
messageInfo Int
5 (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian) IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str [],[])
  | Bool
otherwise = do
     let !datas :: [String]
datas = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
idx,String
str) -> Int -> String
forall a. Show a => a -> String
show Int
idx String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` (Char
'\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String
str)) ([(Int, String)] -> [String])
-> ([a] -> [(Int, String)]) -> [a] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(Int, String)]
forall a. [[a]] -> [(Int, [a])]
trans232 ([String] -> [(Int, String)])
-> ([a] -> [String]) -> [a] -> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f ([a] -> [String]) -> [a] -> [String]
forall a b. (a -> b) -> a -> b
$ [a]
xss
     (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
datas
     String -> IO ()
putStrLn String
""
     String -> IO ()
putStrLn (String -> IO ()) -> (Bool -> String) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
messageInfo Int
2 (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
     String
number <- IO String
getLine
     let !lineRes :: String
lineRes = [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
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
number String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\t")String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
datas
         !ts :: String
ts = 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
'\t') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
lineRes
     String -> IO ()
putStrLn String
ts IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str String
ts,String
ts)

interactivePrintResultRecursive
 :: [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own provided durations
 -> [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own volatile syllable durations.
 -> PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> [String]
 -> Coeffs2
 -> Coeffs2
 -> (a -> String)
 -> [a]
 -> [String]
 -> Bool
 -> Bool -- ^ Whether to use volatile string weights
 -> Int -- ^ Number of sets of volatile string weights for every processed line. Is used when the previous one is 'True'
 -> Int
 -> IO (ReadyForConstructionUkr, String)
interactivePrintResultRecursive :: [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX a -> String
f [a]
xss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
  | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xss = (String -> IO ()
putStrLn (String -> IO ()) -> (Bool -> String) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
messageInfo Int
5 (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian) IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str [],[])
  | Bool
otherwise = do
     let !datas :: [String]
datas = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
idx,String
str) -> Int -> String
forall a. Show a => a -> String
show Int
idx String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` (Char
'\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String
str)) ([(Int, String)] -> [String])
-> ([a] -> [(Int, String)]) -> [a] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(Int, String)]
forall a. [[a]] -> [(Int, [a])]
trans232 ([String] -> [(Int, String)])
-> ([a] -> [String]) -> [a] -> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f ([a] -> [String]) -> [a] -> [String]
forall a b. (a -> b) -> a -> b
$ [a]
xss
     (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
datas
     String -> IO ()
putStrLn String
""
     String -> IO ()
putStrLn (String -> IO ()) -> (Bool -> String) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
messageInfo Int
2 (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
     String
number <- IO String
getLine
     let !lineRes :: String
lineRes = [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
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
number String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\t")String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
datas
         !ts :: String
ts = 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
'\t') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
lineRes
     String -> IO ()
putStrLn (String -> IO ()) -> (Bool -> String) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
messageInfo Int
6 (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
     String
stringInterpreted <- IO String
getLine
     if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
stringInterpreted then String -> IO ()
putStrLn String
ts IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str String
ts,String
ts)
     else do
       let !firstArgs :: [String]
firstArgs = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLetter) [String]
args
       String
strIntrpr <- String -> String -> IO String
convStringInterpreterIO String
stringInterpreted String
ts
       [String]
wordsNN <-
         if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then do
           String -> IO ()
putStrLn (String -> IO ()) -> (Bool -> String) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
messageInfo Int
8 (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
           String
mStr <- IO String
getLine
           let m :: Int
m = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
10 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
mStr::Maybe Int) in [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> (String -> [String]) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
m ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
strIntrpr
         else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> (String -> [String]) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
7 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
strIntrpr
       [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
generalProc2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX ([String]
firstArgs [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
wordsNN) Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose

printWarning :: Bool -> String -> IO String
printWarning :: Bool -> String -> IO String
printWarning Bool
nativeUkrainian String
xs = do
  String -> IO ()
putStrLn (String -> IO ()) -> (Bool -> String) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
messageInfo Int
3 (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
  String -> IO ()
putStrLn String
xs
  IO String
getLine

generalProcMs
 :: [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
 -> [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own volatile syllables durations.
 -> Coeffs2
 -> Coeffs2
 -> [Array Int Int]
 -> [String]
 -> ([Int],String,Int,String)
 -> Bool -- ^ Whether to use volatile string weights
 -> Int -- ^ Number of sets of volatile string weights for every processed line. Is used when the previous one is 'True'
 -> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs :: [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [String]
subs ([Int]
intervalNmbrs, String
arg0, Int
numberI, String
choice) Bool
syllables Int
syllablesVs = do
  let bs :: String
bs = [String] -> String
unwords [String]
subs
  if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
numberI Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then let !frep2 :: FuncRep2 ReadyForConstructionUkr Double Double
frep2 = if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w') String
choice then Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double Double
forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
sDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double -> Double
forall a. a -> a
id Coeffs2
coeffsWX String
choice String
bs else Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double Double
forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
sDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double -> Double
forall a. a -> a
id Coeffs2
coeffs String
choice String
bs
   in [Result2 ReadyForConstructionUkr Double Double]
-> IO [Result2 ReadyForConstructionUkr Double Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Result2 ReadyForConstructionUkr Double Double]
 -> IO [Result2 ReadyForConstructionUkr Double Double])
-> ([String] -> [Result2 ReadyForConstructionUkr Double Double])
-> [String]
-> IO [Result2 ReadyForConstructionUkr Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Result2 ReadyForConstructionUkr Double Double],
 [Result2 ReadyForConstructionUkr Double Double])
-> [Result2 ReadyForConstructionUkr Double Double]
forall a b. (a, b) -> a
fst (([Result2 ReadyForConstructionUkr Double Double],
  [Result2 ReadyForConstructionUkr Double Double])
 -> [Result2 ReadyForConstructionUkr Double Double])
-> ([String]
    -> ([Result2 ReadyForConstructionUkr Double Double],
        [Result2 ReadyForConstructionUkr Double Double]))
-> [String]
-> [Result2 ReadyForConstructionUkr Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'G') String
choice then String
-> [Result2 ReadyForConstructionUkr Double Double]
-> ([Result2 ReadyForConstructionUkr Double Double],
    [Result2 ReadyForConstructionUkr Double Double])
forall (t2 :: * -> *) a b.
(InsertLeft t2 (Result2 a b Double),
 Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
String
-> t2 (Result2 a b Double)
-> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 String
arg0 else Int
-> [Result2 ReadyForConstructionUkr Double Double]
-> ([Result2 ReadyForConstructionUkr Double Double],
    [Result2 ReadyForConstructionUkr Double Double])
forall (t2 :: * -> *) a b c d.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c, Integral d) =>
d -> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR_2 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
arg0::Maybe Int))) ([Result2 ReadyForConstructionUkr Double Double]
 -> ([Result2 ReadyForConstructionUkr Double Double],
     [Result2 ReadyForConstructionUkr Double Double]))
-> ([String] -> [Result2 ReadyForConstructionUkr Double Double])
-> [String]
-> ([Result2 ReadyForConstructionUkr Double Double],
    [Result2 ReadyForConstructionUkr Double Double])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionUkr
 -> Result2 ReadyForConstructionUkr Double Double)
-> [ReadyForConstructionUkr]
-> [Result2 ReadyForConstructionUkr Double Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
-> Result2 ReadyForConstructionUkr Double Double
forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep2) ([ReadyForConstructionUkr]
 -> [Result2 ReadyForConstructionUkr Double Double])
-> ([String] -> [ReadyForConstructionUkr])
-> [String]
-> [Result2 ReadyForConstructionUkr Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ReadyForConstructionUkr)
-> [String] -> [ReadyForConstructionUkr]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadyForConstructionUkr
Str ([String] -> [ReadyForConstructionUkr])
-> ([String] -> [String]) -> [String] -> [ReadyForConstructionUkr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Char
-> (String -> String)
-> ([String] -> [String])
-> (String -> String)
-> [Array Int Int]
-> [String]
-> [String]
forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNBL Char
' ' String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id String -> String
forall a. a -> a
id [Array Int Int]
perms ([String] -> IO [Result2 ReadyForConstructionUkr Double Double])
-> [String] -> IO [Result2 ReadyForConstructionUkr Double Double]
forall a b. (a -> b) -> a -> b
$ [String]
subs
  else do
    let !variants1 :: [String]
variants1 = Char
-> (String -> String)
-> ([String] -> [String])
-> (String -> String)
-> [Array Int Int]
-> [String]
-> [String]
forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNBL Char
' ' String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id String -> String
forall a. a -> a
id [Array Int Int]
perms [String]
subs
        !frep20 :: FuncRep2 ReadyForConstructionUkr Double Double
frep20 = Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double Double
forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
sDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double -> Double
forall a. a -> a
id (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w') String
choice then Coeffs2
coeffsWX else Coeffs2
coeffs) String
choice String
bs
        (!Double
minE,!Double
maxE) = [Double] -> (Double, Double)
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, a)
minMax11C ([Double] -> (Double, Double))
-> ([ReadyForConstructionUkr] -> [Double])
-> [ReadyForConstructionUkr]
-> (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionUkr -> Double)
-> [ReadyForConstructionUkr] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr -> Double
forall a b c. FuncRep2 a b c -> a -> b
toPropertiesF'2 FuncRep2 ReadyForConstructionUkr Double Double
frep20) ([ReadyForConstructionUkr] -> (Double, Double))
-> [ReadyForConstructionUkr] -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ (String -> ReadyForConstructionUkr)
-> [String] -> [ReadyForConstructionUkr]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadyForConstructionUkr
Str [String]
variants1
        !frep2 :: FuncRep2 ReadyForConstructionUkr Double Double
frep2 = Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double Double
forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [[[[Sound8]]] -> [[Double]]]
sDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) (Double -> Double -> Int -> [Int] -> Double -> Double
forall b c.
(RealFrac b, Integral c) =>
b -> b -> c -> [c] -> b -> b
unsafeSwapVecIWithMaxI Double
minE Double
maxE Int
numberI [Int]
intervalNmbrs) (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w') String
choice then Coeffs2
coeffsWX else Coeffs2
coeffs) String
choice String
bs
    [Result2 ReadyForConstructionUkr Double Double]
-> IO [Result2 ReadyForConstructionUkr Double Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Result2 ReadyForConstructionUkr Double Double]
 -> IO [Result2 ReadyForConstructionUkr Double Double])
-> ([ReadyForConstructionUkr]
    -> [Result2 ReadyForConstructionUkr Double Double])
-> [ReadyForConstructionUkr]
-> IO [Result2 ReadyForConstructionUkr Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Result2 ReadyForConstructionUkr Double Double],
 [Result2 ReadyForConstructionUkr Double Double])
-> [Result2 ReadyForConstructionUkr Double Double]
forall a b. (a, b) -> a
fst (([Result2 ReadyForConstructionUkr Double Double],
  [Result2 ReadyForConstructionUkr Double Double])
 -> [Result2 ReadyForConstructionUkr Double Double])
-> ([ReadyForConstructionUkr]
    -> ([Result2 ReadyForConstructionUkr Double Double],
        [Result2 ReadyForConstructionUkr Double Double]))
-> [ReadyForConstructionUkr]
-> [Result2 ReadyForConstructionUkr Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'G') String
choice then String
-> [Result2 ReadyForConstructionUkr Double Double]
-> ([Result2 ReadyForConstructionUkr Double Double],
    [Result2 ReadyForConstructionUkr Double Double])
forall (t2 :: * -> *) a b.
(InsertLeft t2 (Result2 a b Double),
 Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
String
-> t2 (Result2 a b Double)
-> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 String
arg0 else Int
-> [Result2 ReadyForConstructionUkr Double Double]
-> ([Result2 ReadyForConstructionUkr Double Double],
    [Result2 ReadyForConstructionUkr Double Double])
forall (t2 :: * -> *) a b c d.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c, Integral d) =>
d -> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR_2 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
arg0::Maybe Int))) ([Result2 ReadyForConstructionUkr Double Double]
 -> ([Result2 ReadyForConstructionUkr Double Double],
     [Result2 ReadyForConstructionUkr Double Double]))
-> ([ReadyForConstructionUkr]
    -> [Result2 ReadyForConstructionUkr Double Double])
-> [ReadyForConstructionUkr]
-> ([Result2 ReadyForConstructionUkr Double Double],
    [Result2 ReadyForConstructionUkr Double Double])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionUkr
 -> Result2 ReadyForConstructionUkr Double Double)
-> [ReadyForConstructionUkr]
-> [Result2 ReadyForConstructionUkr Double Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
-> Result2 ReadyForConstructionUkr Double Double
forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep2) ([ReadyForConstructionUkr]
 -> IO [Result2 ReadyForConstructionUkr Double Double])
-> [ReadyForConstructionUkr]
-> IO [Result2 ReadyForConstructionUkr Double Double]
forall a b. (a -> b) -> a -> b
$ (String -> ReadyForConstructionUkr)
-> [String] -> [ReadyForConstructionUkr]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadyForConstructionUkr
Str [String]
variants1

show2 :: a -> [Result2 ReadyForConstructionUkr a a] -> String
show2 a
verbose jjs :: [Result2 ReadyForConstructionUkr a a]
jjs@(R2  ReadyForConstructionUkr
x a
y a
z:[Result2 ReadyForConstructionUkr a a]
_) = [Result2 ReadyForConstructionUkr a a] -> String
forall a a.
(Show a, Show a) =>
[Result2 ReadyForConstructionUkr a a] -> String
show1 [Result2 ReadyForConstructionUkr a a]
bs   
      where bs :: [Result2 ReadyForConstructionUkr a a]
bs = (Result2 ReadyForConstructionUkr a a
 -> Result2 ReadyForConstructionUkr a a -> Ordering)
-> [Result2 ReadyForConstructionUkr a a]
-> [Result2 ReadyForConstructionUkr a a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(R2 ReadyForConstructionUkr
xs a
d1 a
k1) (R2 ReadyForConstructionUkr
ys a
d2 a
k2) -> case a
verbose of 
              a
2 -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
d2 a
d1
              a
1 -> ReadyForConstructionUkr -> ReadyForConstructionUkr -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ReadyForConstructionUkr
xs ReadyForConstructionUkr
ys
              a
3 -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k2 a
k1
              a
_ -> Ordering
EQ) [Result2 ReadyForConstructionUkr a a]
jjs 
            show1 :: [Result2 ReadyForConstructionUkr a a] -> String
show1 qqs :: [Result2 ReadyForConstructionUkr a a]
qqs@(R2 ReadyForConstructionUkr
x a
y a
z:[Result2 ReadyForConstructionUkr a a]
ks) =  ReadyForConstructionUkr -> String
showR ReadyForConstructionUkr
x String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"->" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` a -> String
forall a. Show a => a -> String
show a
y String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"->" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` a -> String
forall a. Show a => a -> String
show a
z String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\n" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` [Result2 ReadyForConstructionUkr a a] -> String
show1 [Result2 ReadyForConstructionUkr a a]
ks
            show1 [Result2 ReadyForConstructionUkr a a]
_ = String
""

print2 :: a -> [Result2 ReadyForConstructionUkr a a] -> IO ()
print2 a
verbose = String -> IO ()
putStrLn (String -> IO ())
-> ([Result2 ReadyForConstructionUkr a a] -> String)
-> [Result2 ReadyForConstructionUkr a a]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Result2 ReadyForConstructionUkr a a] -> String
forall a a a.
(Show a, Show a, Num a, Ord a, Ord a, Eq a) =>
a -> [Result2 ReadyForConstructionUkr a a] -> String
show2 a
verbose
-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
generalProcMMs
 :: [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
 -> [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own volatile syllables durations.
 -> PermutationsType  -- ^ Whether to use just pairwise permutations, or the full universal set.
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> [String]
 -> Coeffs2
 -> Coeffs2
 -> [([Int],String,Int,String)]
 -> [Array Int Int]
 -> [String]
 -> [String]
 -> Bool
 -> Bool -- ^ Whether to use volatile string weights
 -> Int -- ^ Number of sets of volatile string weights for every processed line. Is used when the previous one is 'True'
 -> Int
 -> IO (ReadyForConstructionUkr, String)
generalProcMMs :: [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [([Int], String, Int, String)]
-> [Array Int Int]
-> [String]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
generalProcMMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactiveMM Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [([Int], String, Int, String)]
rs [Array Int Int]
perms [String]
subs [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose =
 case [([Int], String, Int, String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Int], String, Int, String)]
rs of
  Int
0 -> String -> IO ()
putStrLn (Int -> Bool -> String
messageInfo Int
4 Bool
nativeUkrainian) IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str [],[])
  Int
1 -> String -> IO ()
putStrLn (Int -> Bool -> String
messageInfo Int
5 Bool
nativeUkrainian) IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
        [Result2 ReadyForConstructionUkr Double Double]
temp <- [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [String]
subs ([([Int], String, Int, String)] -> ([Int], String, Int, String)
forall a. [a] -> a
head [([Int], String, Int, String)]
rs) Bool
syllables Int
syllablesVs
        if Int
verbose Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1..Int
3] then Int -> [Result2 ReadyForConstructionUkr Double Double] -> IO ()
forall a a a.
(Show a, Show a, Num a, Ord a, Ord a, Eq a) =>
a -> [Result2 ReadyForConstructionUkr a a] -> IO ()
print2 Int
verbose [Result2 ReadyForConstructionUkr Double Double]
temp IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"" else String -> IO ()
putStr String
""
        [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
finalProc [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactiveMM Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (String -> ReadyForConstructionUkr -> String
convFSL ([String] -> String
unwords [String]
args) (ReadyForConstructionUkr -> String)
-> (Result2 ReadyForConstructionUkr Double Double
    -> ReadyForConstructionUkr)
-> Result2 ReadyForConstructionUkr Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
  Int
_ -> do
         [[Result2 ReadyForConstructionUkr Double Double]]
genVariants <- (([Int], String, Int, String)
 -> IO [Result2 ReadyForConstructionUkr Double Double])
-> [([Int], String, Int, String)]
-> IO [[Result2 ReadyForConstructionUkr Double Double]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\([Int], String, Int, String)
k -> [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [String]
subs ([Int], String, Int, String)
k Bool
syllables Int
syllablesVs) [([Int], String, Int, String)]
rs
         if Int
verbose Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1..Int
3] then ([Result2 ReadyForConstructionUkr Double Double] -> IO ())
-> [[Result2 ReadyForConstructionUkr Double Double]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Result2 ReadyForConstructionUkr Double Double]
t -> Int -> [Result2 ReadyForConstructionUkr Double Double] -> IO ()
forall a a a.
(Show a, Show a, Num a, Ord a, Ord a, Eq a) =>
a -> [Result2 ReadyForConstructionUkr a a] -> IO ()
print2 Int
verbose [Result2 ReadyForConstructionUkr Double Double]
t IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"") [[Result2 ReadyForConstructionUkr Double Double]]
genVariants else String -> IO ()
putStr String
""
         [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (ReadyForConstructionUkr -> String)
-> [ReadyForConstructionUkr]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
finalProc [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactiveMM Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (String -> ReadyForConstructionUkr -> String
convFSL ([String] -> String
unwords [String]
args)) (String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI ([String] -> String
unwords [String]
args) ([[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr])
-> ([[Result2 ReadyForConstructionUkr Double Double]]
    -> [[ReadyForConstructionUkr]])
-> [[Result2 ReadyForConstructionUkr Double Double]]
-> [ReadyForConstructionUkr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Result2 ReadyForConstructionUkr Double Double]
 -> [ReadyForConstructionUkr])
-> [[Result2 ReadyForConstructionUkr Double Double]]
-> [[ReadyForConstructionUkr]]
forall a b. (a -> b) -> [a] -> [b]
map ((Result2 ReadyForConstructionUkr Double Double
 -> ReadyForConstructionUkr)
-> [Result2 ReadyForConstructionUkr Double Double]
-> [ReadyForConstructionUkr]
forall a b. (a -> b) -> [a] -> [b]
map Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2) ([[Result2 ReadyForConstructionUkr Double Double]]
 -> [ReadyForConstructionUkr])
-> [[Result2 ReadyForConstructionUkr Double Double]]
-> [ReadyForConstructionUkr]
forall a b. (a -> b) -> a -> b
$ [[Result2 ReadyForConstructionUkr Double Double]]
genVariants) [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose

-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
finalProc
 :: [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
 -> [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own volatile syllables durations.
 -> PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> [String]
 -> Coeffs2
 -> Coeffs2
 -> (a -> String)
 -> [a]
 -> [String]
 -> Bool
 -> Bool -- ^ Whether to use volatile string weights
 -> Int -- ^ Number of sets of volatile string weights for every processed line. Is used when the previous one is 'True'
 -> Int
 -> IO (ReadyForConstructionUkr, String)
finalProc :: [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
finalProc [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX a -> String
f [a]
xss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | Bool
recursiveMode = [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX a -> String
f [a]
xss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | Bool
interactive = Bool
-> (a -> String)
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
forall a.
Bool
-> (a -> String)
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, String)
interactivePrintResult Bool
nativeUkrainian a -> String
f [a]
xss Bool
syllables Int
syllablesVs
 | Bool
otherwise = String -> IO ()
putStrLn String
ts IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str String
ts,String
ts)
  where ts :: String
ts = (a -> String) -> [a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
t -> a -> String
f a
t String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding) [a]
xss

-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
print1el
 :: Bool
 -> String
 -> [Result2 ReadyForConstructionUkr Double Double]
 -> IO (ReadyForConstructionUkr, String)
print1el :: Bool
-> String
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, String)
print1el Bool
jstlines String
choice [Result2 ReadyForConstructionUkr Double Double]
y
 | Bool
jstlines Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True = String -> IO ()
putStrLn String
us IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str String
us,String
us)
 | Bool
otherwise = String -> IO ()
putStrLn String
zs IO ()
-> IO (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionUkr, String)
-> IO (ReadyForConstructionUkr, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionUkr
Str String
zs,String
zs)
       where !ch :: Maybe Int
ch = String -> Maybe Int
precChoice String
choice
             !us :: String
us = (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Result2 ReadyForConstructionUkr Double Double
ys -> ReadyForConstructionUkr -> String
showR (Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2 Result2 ReadyForConstructionUkr Double Double
ys) String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding) [Result2 ReadyForConstructionUkr Double Double]
y

             !zs :: String
zs = (Result2 ReadyForConstructionUkr Double Double -> String)
-> [Result2 ReadyForConstructionUkr Double Double] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Result2 ReadyForConstructionUkr Double Double
ys -> ReadyForConstructionUkr -> String
showR (Result2 ReadyForConstructionUkr Double Double
-> ReadyForConstructionUkr
forall a b c. Result2 a b c -> a
line2 Result2 ReadyForConstructionUkr Double Double
ys) String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
ch (Result2 ReadyForConstructionUkr Double Double -> Double
forall a b c. Result2 a b c -> b
propertiesF2 Result2 ReadyForConstructionUkr Double Double
ys) (String
newLineEnding String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
ch (Result2 ReadyForConstructionUkr Double Double -> Double
forall a b c. Result2 a b c -> c
transPropertiesF2 Result2 ReadyForConstructionUkr Double Double
ys) String
newLineEnding)) [Result2 ReadyForConstructionUkr Double Double]
y