{-# 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 Data.Char
--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 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.ArgsConversion
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 Phonetic.Languages.Coeffs

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

{-| 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 :: [Char]
-> PermutationsType
-> [[Char]]
-> [Char]
-> Int
-> Bool
-> Bool
-> [Char]
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc3G [Char]
fileDu PermutationsType
pairwisePermutations [[Char]]
textProcessmentFss [Char]
textProcessment0 Int
textProcessment1 Bool
recursiveMode Bool
nativeUkrainian [Char]
toFileMode1 Bool
interactiveP Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW Bool
syllables Int
syllablesVs Int
verbose = do
  [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs <- [Char] -> IO [[[[Sound8]]] -> [[Double]]]
readSyllableDurations [Char]
fileDu
  forall {t :: * -> *} {t :: * -> *} {p} {a}.
(Foldable t, Foldable t, Eq p, Num p) =>
[[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> t [Char]
-> t a
-> p
-> Bool
-> Bool
-> [Char]
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc3G' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations [[Char]]
textProcessmentFss [Char]
textProcessment0 Int
textProcessment1 Bool
recursiveMode Bool
nativeUkrainian [Char]
toFileMode1 Bool
interactiveP Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW Bool
syllables Int
syllablesVs Int
verbose
    where generalProc3G' :: [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> t [Char]
-> t a
-> p
-> Bool
-> Bool
-> [Char]
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc3G' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations t [Char]
textProcessmentFss t a
textProcessment0 p
textProcessment1 Bool
recursiveMode Bool
nativeUkrainian [Char]
toFileMode1 Bool
interactiveP Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW Bool
syllables Int
syllablesVs Int
verbose
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
textProcessment0 = [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> [Char]
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian [Char]
toFileMode1 Bool
interactiveP Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW Bool
syllables Int
syllablesVs Int
verbose
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null t [Char]
textProcessmentFss = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Integer
_ -> do  -- interactive training mode
                 [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Char]
messageInfo Int
7 forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
                 [Char]
lineA <- IO [Char]
getLine
                 [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> [Char]
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian [Char]
toFileMode1 Bool
interactiveP Bool
jstL0 (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
mightNotUkrWord [Char]
lineA [[Char]]
args0) Coeffs2
coeffs Coeffs2
coeffsWX (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
mightNotUkrWord [Char]
lineA [[Char]]
args) Bool
lstW  Bool
syllables Int
syllablesVs Int
verbose) [Integer
0..]
            | Bool
otherwise =
                 forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Char]
js -> do
                  let !kss :: [[Char]]
kss = [Char] -> [[Char]]
lines [Char]
js
                  if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then do
                    let !wss :: [[Char]]
wss
                         | p
textProcessment1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [p
10,p
20,p
30,p
40,p
50,p
60,p
70,p
80,p
90] = [[Char]]
kss
                         | Bool
otherwise = Int -> Int -> [Char] -> [[Char]]
prepareTuneTextMN Int
m Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ [[Char]]
kss
                    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Char]
tss -> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> [Char]
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian [Char]
toFileMode1 Bool
interactiveP Bool
jstL0 (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
mightNotUkrWord [Char]
tss [[Char]]
args0) Coeffs2
coeffs Coeffs2
coeffsWX
                      (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
mightNotUkrWord [Char]
tss [[Char]]
args) Bool
lstW Bool
syllables Int
syllablesVs Int
verbose) [[Char]]
wss
                  else do
                    let !wss :: [[Char]]
wss
                         | p
textProcessment1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [p
20,p
30,p
40,p
50,p
60,p
70] = [[Char]]
kss
                         | Bool
otherwise = Int -> Int -> [Char] -> [[Char]]
prepareTuneTextMN (if p
textProcessment1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [p
21,p
31,p
41,p
51,p
61] then Int
m else Int
7) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ [[Char]]
kss
                    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Char]
tss -> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> [Char]
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian [Char]
toFileMode1 Bool
interactiveP Bool
jstL0 (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
mightNotUkrWord [Char]
tss [[Char]]
args0) Coeffs2
coeffs Coeffs2
coeffsWX
                      (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
mightNotUkrWord [Char]
tss [[Char]]
args) Bool
lstW Bool
syllables Int
syllablesVs Int
verbose) [[Char]]
wss) t [Char]
textProcessmentFss
          m :: Int
m = if Int
textProcessment1 forall a. Eq a => a -> a -> Bool
== Int
10 Bool -> Bool -> Bool
|| Int
textProcessment1 forall a. Eq a => a -> a -> Bool
== Int
11 then Int
10 else 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 :: [Char] -> Bool
mightNotUkrWord [Char]
xs
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ts Bool -> Bool -> Bool
|| [Char]
ts forall a. Eq a => a -> a -> Bool
== [Char]
"-" = Bool
True
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isAlpha [Char]
us = Bool
True
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isUkrainianN) [Char]
us) = Bool
False
 | Bool
otherwise = Bool
True
     where ([Char]
ts,[Char]
us) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span Char -> Bool
isUkrainianN [Char]
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
-> [Char]
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian [Char]
toFile1 Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | [[Char]] -> Bool
variations [[Char]]
args = do
    let !zsss :: [[[Char]]]
zsss = [[Char]] -> [[[Char]]]
transformToVariations [[Char]]
args
    [(ReadyForConstructionUkr, [Char])]
variantsG <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[[Char]]
xss -> [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
generalProc2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [] PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
xss Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose) [[[Char]]]
zsss
    if Bool
interactive then do 
           (if Bool
recursiveMode then forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [] PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0  [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (ReadyForConstructionUkr -> [Char]
showR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ReadyForConstructionUkr, [Char])]
variantsG [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
           else forall a.
Bool
-> (a -> [Char])
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResult Bool
nativeUkrainian (ReadyForConstructionUkr -> [Char]
showR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ReadyForConstructionUkr, [Char])]
variantsG Bool
syllables Int
syllablesVs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ReadyForConstructionUkr
rs,[Char]
cs) ->
            case [Char]
toFile1 of
               [Char]
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
               ~[Char]
fileName -> [Char] -> [Char] -> IO ()
appendFile [Char]
fileName ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
cs ReadyForConstructionUkr
rs forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding)
    else forall (m :: * -> *) a. Monad m => a -> m a
return () 
 | Bool
otherwise = [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
generalProc2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [] PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \(ReadyForConstructionUkr
rs,[Char]
cs) ->
      case [Char]
toFile1 of
       [Char]
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       ~[Char]
fileName -> [Char] -> [Char] -> IO ()
appendFile [Char]
fileName ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
cs ReadyForConstructionUkr
rs forall a. Monoid a => a -> a -> a
`mappend` [Char]
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
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
generalProc2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose = do
 let !argMss :: [([Char], [[Char]])]
argMss = forall a. Int -> [a] -> [a]
take Int
5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [([Char], [[Char]])]
forMultiplePropertiesF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= [Char]
"+m") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= [Char]
"-m") forall a b. (a -> b) -> a -> b
$ [[Char]]
args0
 if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], [[Char]])]
argMss then do
  let (![[Char]]
numericArgs,![[Char]]
textualArgs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) forall a b. (a -> b) -> a -> b
$ [[Char]]
args
      !bs :: [Char]
bs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [Char] -> [[Char]]
prepareTuneTextMN (if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then Int
10 else Int
7) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ [[Char]]
textualArgs
      !xs :: ReadyForConstructionUkr
xs = [Char] -> ReadyForConstructionUkr
Str [Char]
bs
      !l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words forall a b. (a -> b) -> a -> b
$ [Char]
bs
      !argCs :: [EncodedCnstrs]
argCs = forall a. [Maybe a] -> [a]
catMaybes (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Char] -> Maybe EncodedCnstrs
readMaybeECG (Int
l forall a. Num a => a -> a -> a
- Int
1)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool -> [Char]
showB Int
l Bool
lstW2forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= [Char]
"+a") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= [Char]
"-a") forall a b. (a -> b) -> a -> b
$ [[Char]]
args0)
      !arg0 :: [Char]
arg0 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ [[Char]]
numericArgs
      !numberI :: Int
numberI = forall a. a -> Maybe a -> a
fromMaybe Int
1 forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [[Char]]
numericArgs)::Maybe Int)
      !choice :: [Char]
choice = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ [[Char]]
textualArgs
      !sels :: [Sound8]
sels = [Char] -> [Sound8]
parsey0Choice [Char]
choice
      !intervalNmbrs :: [Int]
intervalNmbrs = (\[Int]
zs -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
zs then [Int
numberI] else forall a. Eq a => [a] -> [a]
L.nub [Int]
zs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
L.sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
<= Int
numberI) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
t -> forall a. a -> Maybe a -> a
fromMaybe Int
numberI forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
t::Maybe Int)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall a b. (a -> b) -> a -> b
$ [[Char]]
numericArgs
  (if Bool
syllables then do Int
-> Bool
-> [Char]
-> IO
     ([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
      ReadyForConstructionUkr)
weightsString3NIO Int
syllablesVs (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice) [Char]
bs else forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],[Char] -> ReadyForConstructionUkr
Str [])) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \([[[Sound8]]]
syllDs,[[[[Sound8]]] -> [[Double]]]
syllableDs,ReadyForConstructionUkr
readys) -> do 
   if forall a. Ord a => a -> a -> Ordering
compare Int
l Int
2 forall a. Eq a => a -> a -> Bool
== Ordering
LT then let !frep20 :: FuncRep2 ReadyForConstructionUkr Double Double
frep20 = 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
-> [Sound8]
-> [Char]
-> [Char]
-> 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) forall a. a -> a
id (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t forall a. Eq a => a -> a -> Bool
== Char
'w') [Char]
choice then Coeffs2
coeffsWX else  Coeffs2
coeffs) [Sound8]
sels [Char]
choice [Char]
bs
                                 !wwss :: [Result2 ReadyForConstructionUkr Double Double]
wwss = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep20 forall a b. (a -> b) -> a -> b
$ ReadyForConstructionUkr
xs in
    case Bool
recursiveMode of
      Bool
True -> forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
wwss [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
      Bool
_ -> if Bool
interactive then forall a.
Bool
-> (a -> [Char])
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResult Bool
nativeUkrainian ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
wwss Bool
syllables Int
syllablesVs else Bool
-> [Char]
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, [Char])
print1el Bool
jstL0 [Char]
choice [Result2 ReadyForConstructionUkr Double Double]
wwss
   else do
    let !subs :: [[Char]]
subs = forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG [Char]
" " [Char]
bs -- Probably, here it can just 'words' be used.
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EncodedCnstrs]
argCs then let !perms :: [Array Int Int]
perms
                             | PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 = Int -> [Array Int Int]
genPairwisePermutationsLN Int
l
                             | PermutationsType
pairwisePermutations 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]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs ([Int]
intervalNmbrs, [Char]
arg0, Int
numberI, [Char]
choice) Bool
syllables Int
syllablesVs 
          if Bool
recursiveMode then forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
          else if Bool
interactive then forall a.
Bool
-> (a -> [Char])
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResult Bool
nativeUkrainian ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp Bool
syllables Int
syllablesVs else Bool
-> [Char]
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, [Char])
print1el Bool
jstL0 [Char]
choice [Result2 ReadyForConstructionUkr Double Double]
temp
    else do
     [Char]
correct <- Bool -> [Char] -> IO [Char]
printWarning Bool
nativeUkrainian [Char]
bs
     if [Char]
correct forall a. Eq a => a -> a -> Bool
== [Char]
"n" then [Char] -> IO ()
putStrLn (Int -> Bool -> [Char]
messageInfo Int
1 Bool
nativeUkrainian) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> 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 = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
[EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints [EncodedCnstrs]
argCs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 then Int -> [Array Int Int]
genPairwisePermutationsLN else if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
0 then Int -> [Array Int Int]
genPermutationsL else Int -> [Array Int Int]
genElementaryPermutationsLN1) 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]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs ([Int]
intervalNmbrs, [Char]
arg0, Int
numberI, [Char]
choice) Bool
syllables Int
syllablesVs 
          if Bool
recursiveMode then forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
sDs) PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
          else if Bool
interactive then forall a.
Bool
-> (a -> [Char])
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResult Bool
nativeUkrainian ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp Bool
syllables Int
syllablesVs else Bool
-> [Char]
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, [Char])
print1el Bool
jstL0 [Char]
choice [Result2 ReadyForConstructionUkr Double Double]
temp
--------------------------------------------------------
  else do
   let !choices :: [[Char]]
choices = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [([Char], [[Char]])]
argMss
       !numericArgss :: [[[Char]]]
numericArgss = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [([Char], [[Char]])]
argMss
       !arg0s :: [[Char]]
arg0s = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1) [[[Char]]]
numericArgss
       !numberIs :: [Int]
numberIs = forall a b. (a -> b) -> [a] -> [b]
map (\[[Char]]
ts -> forall a. a -> Maybe a -> a
fromMaybe Int
1 forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [[Char]]
ts)::Maybe Int)) [[[Char]]]
numericArgss
       !intervalNmbrss :: [[Int]]
intervalNmbrss = forall a b. (a -> b) -> [a] -> [b]
map (\[[Char]]
us -> let !numberI :: Int
numberI = forall a. a -> Maybe a -> a
fromMaybe Int
1 forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [[Char]]
us)::Maybe Int) in
         (\[Int]
zs -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
zs then [Int
numberI] else forall a. Eq a => [a] -> [a]
L.nub [Int]
zs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
L.sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
<= Int
numberI) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
t -> forall a. a -> Maybe a -> a
fromMaybe Int
numberI forall a b. (a -> b) -> a -> b
$ (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
t::Maybe Int)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall a b. (a -> b) -> a -> b
$ [[Char]]
us) forall a b. (a -> b) -> a -> b
$ [[[Char]]]
numericArgss
       !argsZipped :: [([Int], [Char], Int, [Char])]
argsZipped = forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
L.zip4 [[Int]]
intervalNmbrss [[Char]]
arg0s [Int]
numberIs [[Char]]
choices
       !bs :: [Char]
bs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [Char] -> [[Char]]
prepareTuneTextMN (if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then Int
10 else Int
7) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ [[Char]]
args
       !xs :: ReadyForConstructionUkr
xs = [Char] -> ReadyForConstructionUkr
Str [Char]
bs
       !l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words forall a b. (a -> b) -> a -> b
$ [Char]
bs
       !argCs :: [EncodedCnstrs]
argCs = forall a. [Maybe a] -> [a]
catMaybes (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Char] -> Maybe EncodedCnstrs
readMaybeECG (Int
l forall a. Num a => a -> a -> a
- Int
1)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool -> [Char]
showB Int
l Bool
lstW2forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= [Char]
"+a") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= [Char]
"-a") forall a b. (a -> b) -> a -> b
$ [[Char]]
args0)
   ([[[Sound8]]]
syllDs,[[[[Sound8]]] -> [[Double]]]
syllableDs,ReadyForConstructionUkr
readys) <- do if Bool
syllables then Int
-> Bool
-> [Char]
-> IO
     ([[[Sound8]]], [[[[Sound8]]] -> [[Double]]],
      ReadyForConstructionUkr)
weightsString3NIO Int
syllablesVs (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. a -> a
id (forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a')) [[Char]]
choices)) [Char]
bs else forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],[[[Sound8]]] -> ReadyForConstructionUkr
FSL [])
   if forall a. Ord a => a -> a -> Ordering
compare Int
l Int
2 forall a. Eq a => a -> a -> Bool
== Ordering
LT then let !frep20 :: FuncRep2 ReadyForConstructionUkr Double Double
frep20 = 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
-> [Sound8]
-> [Char]
-> [Char]
-> 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ [[Char]]
choices then [[[[Sound8]]] -> [[Double]]]
syllableDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) forall a. a -> a
id Coeffs2
coeffs [] (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ [[Char]]
choices) [Char]
bs
                                 !wwss :: [Result2 ReadyForConstructionUkr Double Double]
wwss = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep20 forall a b. (a -> b) -> a -> b
$ ReadyForConstructionUkr
xs in
     case Bool
recursiveMode of
       Bool
True -> forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
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 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
wwss [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
       Bool
_ -> if Bool
interactive then forall a.
Bool
-> (a -> [Char])
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResult Bool
nativeUkrainian ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
wwss Bool
syllables Int
syllablesVs else Bool
-> [Char]
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, [Char])
print1el Bool
jstL0 (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ [[Char]]
choices) [Result2 ReadyForConstructionUkr Double Double]
wwss
   else do
    let !subs :: [[Char]]
subs = forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG [Char]
" " [Char]
bs
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EncodedCnstrs]
argCs then let !perms :: [Array Int Int]
perms
                             | PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 = Int -> [Array Int Int]
genPairwisePermutationsLN Int
l
                             | PermutationsType
pairwisePermutations 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
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [([Int], [Char], Int, [Char])]
-> [Array Int Int]
-> [[Char]]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
generalProcMMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
syllableDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [([Int], [Char], Int, [Char])]
argsZipped [Array Int Int]
perms [[Char]]
subs [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
    else do
     [Char]
correct <- Bool -> [Char] -> IO [Char]
printWarning Bool
nativeUkrainian [Char]
bs
     if [Char]
correct forall a. Eq a => a -> a -> Bool
== [Char]
"n" then [Char] -> IO ()
putStrLn (Int -> Bool -> [Char]
messageInfo Int
1 Bool
nativeUkrainian) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> 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 = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
[EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints [EncodedCnstrs]
argCs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 then Int -> [Array Int Int]
genPairwisePermutationsLN else if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
0 then Int -> [Array Int Int]
genPermutationsL else Int -> [Array Int Int]
genElementaryPermutationsLN1) forall a b. (a -> b) -> a -> b
$ Int
l in [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [([Int], [Char], Int, [Char])]
-> [Array Int Int]
-> [[Char]]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
generalProcMMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
syllableDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [([Int], [Char], Int, [Char])]
argsZipped [Array Int Int]
perms [[Char]]
subs [[Char]]
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 -> [Char]
messageInfo Int
n Bool
True
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
1 = [Char]
"Ви зупинили програму, будь ласка, якщо потрібно, виконайте її знову з кращими аргументами. "
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
2 = [Char]
"Будь ласка, вкажіть варіант (який Ви бажаєте, щоб він став результуючим рядком) за його номером. "
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
3 = [Char]
"Будь ласка, перевірте, чи рядок нижче відповідає і узгоджується з обмеженнями, які Ви вказали між +a та -a опціями. Перевірте також, чи Ви вказали \"+b\" чи \"+bl\" опцію(ї). Якщо введені опції та аргументи не узгоджені з виведеним далі рядком, тоді введіть далі \"n\", натисніть Enter і опісля запустіть програму на виконання знову з кращими аргументами. " forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding forall a. Monoid a => a -> a -> a
`mappend` [Char]
"Якщо рядок узгоджується з Вашим вводом між +a та -a, тоді просто натисніть Enter, щоб продовжити далі. " forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
4 = [Char]
"Було задано недостатньо інформації для продовження обчислювального процесу "
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
5 = [Char]
"(/ Ви вказали властивості(ість) та діапазон(и) для них такі, що для даних слів та їх сполучень варіантів немає. Спробуйте змінити параметри виклику програми (бібліотеки) /)"
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
6 = [Char]
"Якщо бажаєте запустити програму (функцію) рекурсивно, змінюючи сполучення слів та букв, введіть тут закодований рядок інтерпретатора. Якщо бажаєте не використовувати програму (функцію) рекурсивно, просто натисніть Enter. "
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
7 = [Char]
"Введіть, будь ласка, рядок слів для аналізу. "
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
8 = [Char]
"Введіть, будь ласка, кількість слів чи їх сполучень, які програма розглядатиме як один рядок для аналізу. "
 | Bool
otherwise = [Char]
"Ви вказали лише один варіант властивостей. "
messageInfo Int
n Bool
False
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
1 = [Char]
"You stopped the program, please, if needed, run it again with better arguments. "
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
2 = [Char]
"Please, specify the variant which you would like to become the resulting string by its number. "
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
3 = [Char]
"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. " forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding forall a. Monoid a => a -> a -> a
`mappend` [Char]
"If the line is consistent with your input between +a and -a then just press Enter to proceed further. " forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
4 = [Char]
"No data has been specified to control the computation process. "
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
5 = [Char]
"(/ 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 forall a. Eq a => a -> a -> Bool
== Int
6 = [Char]
"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 forall a. Eq a => a -> a -> Bool
== Int
7 = [Char]
"Please, input the text line for analysis. "
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
8 = [Char]
"Please, input the number of words or their concatenations that the program takes as one line for analysis. "
 | Bool
otherwise = [Char]
"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 :: forall a.
Bool
-> (a -> [Char])
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResult Bool
nativeUkrainian a -> [Char]
f [a]
xss Bool
syllables Int
syllablesVs
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xss = ([Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Char]
messageInfo Int
5 forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionUkr
Str [],[])
  | Bool
otherwise = do
     let !datas :: [[Char]]
datas = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
idx,[Char]
str) -> forall a. Show a => a -> [Char]
show Int
idx forall a. Monoid a => a -> a -> a
`mappend` (Char
'\t' forall a. a -> [a] -> [a]
: [Char]
str)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [(Int, [a])]
trans232 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
f forall a b. (a -> b) -> a -> b
$ [a]
xss
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [[Char]]
datas
     [Char] -> IO ()
putStrLn [Char]
""
     [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Char]
messageInfo Int
2 forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
     [Char]
number <- IO [Char]
getLine
     let !lineRes :: [Char]
lineRes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (([Char]
number forall a. Monoid a => a -> a -> a
`mappend` [Char]
"\t")forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) forall a b. (a -> b) -> a -> b
$ [[Char]]
datas
         !ts :: [Char]
ts = forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\t') forall a b. (a -> b) -> a -> b
$ [Char]
lineRes
     [Char] -> IO ()
putStrLn [Char]
ts forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionUkr
Str [Char]
ts,[Char]
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 :: forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX a -> [Char]
f [a]
xss [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xss = ([Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Char]
messageInfo Int
5 forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionUkr
Str [],[])
  | Bool
otherwise = do
     let !datas :: [[Char]]
datas = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
idx,[Char]
str) -> forall a. Show a => a -> [Char]
show Int
idx forall a. Monoid a => a -> a -> a
`mappend` (Char
'\t' forall a. a -> [a] -> [a]
: [Char]
str)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [(Int, [a])]
trans232 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
f forall a b. (a -> b) -> a -> b
$ [a]
xss
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [[Char]]
datas
     [Char] -> IO ()
putStrLn [Char]
""
     [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Char]
messageInfo Int
2 forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
     [Char]
number <- IO [Char]
getLine
     let !lineRes :: [Char]
lineRes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (([Char]
number forall a. Monoid a => a -> a -> a
`mappend` [Char]
"\t")forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) forall a b. (a -> b) -> a -> b
$ [[Char]]
datas
         !ts :: [Char]
ts = forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\t') forall a b. (a -> b) -> a -> b
$ [Char]
lineRes
     [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Char]
messageInfo Int
6 forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
     [Char]
stringInterpreted <- IO [Char]
getLine
     if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
stringInterpreted then [Char] -> IO ()
putStrLn [Char]
ts forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionUkr
Str [Char]
ts,[Char]
ts)
     else do
       let ([Char]
strI10,[Char]
convArgs0) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'+') [Char]
stringInterpreted
           strI1 :: [Char]
strI1 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) [Char]
strI10
           ([Char]
convArgs1,[Char]
convArgs) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 [Char]
convArgs0
           cnvArgs :: Int
cnvArgs = forall a. Ord a => a -> a -> a
min Int
1 (forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. Read a => [Char] -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
drop Int
1 [Char]
convArgs1)::Maybe Int))
           ([Char]
fileDu1,PermutationsType
pairwisePermutations1,Bool
nativeUkrainian1,Bool
jstL01,[[Char]]
args01,Coeffs2
coeffs1,Coeffs2
coeffsWX1,[[Char]]
args1,Bool
lstW1,Bool
syllables1,Int
syllablesVs1,Int
verbose1) = [Char]
-> ([Char], PermutationsType, Bool, Bool, [[Char]], Coeffs2,
    Coeffs2, [[Char]], Bool, Bool, Int, Int)
argsConversion [Char]
convArgs
           nativeUkrainian2 :: Bool
nativeUkrainian2 
             | Bool
nativeUkrainian1 = Bool
nativeUkrainian1
             | Bool
otherwise = Bool
nativeUkrainian 
           lstW3 :: Bool
lstW3 = if Bool
lstW1 then Bool
lstW1 else Bool
lstW2
           jstL02 :: Bool
jstL02 = if Bool
jstL01 then Bool
jstL01 else Bool
jstL0
--           !firstArgs = takeWhile (not . all isLetter) args2
           args02 :: [[Char]]
args02 = if Int
cnvArgs forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
cnvArgs forall a. Ord a => a -> a -> Bool
< Int
5 then [[Char]]
args01 else [[Char]]
args0
           args2 :: [[Char]]
args2 = if Int
cnvArgs forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
2,Int
5,Int
6] then  [[Char]]
args1 else [[Char]]
args
           firstArgs :: [[Char]]
firstArgs = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all  Char -> Bool
isLetter) [[Char]]
args2
           coeffs2 :: Coeffs2
coeffs2 = if forall a. CoeffTwo a -> Bool
isPair Coeffs2
coeffs1 then Coeffs2
coeffs1 else Coeffs2
coeffs
           coeffsWX2 :: Coeffs2
coeffsWX2 = if forall a. CoeffTwo a -> Bool
isPair Coeffs2
coeffsWX1 then Coeffs2
coeffsWX1 else Coeffs2
coeffsWX
           syllables2 :: Bool
syllables2 = if Bool
syllables1 then Bool
syllables1 else Bool
syllables
           syllablesVs2 :: Int
syllablesVs2 = if Bool
syllables1 then Int
syllablesVs1 else Int
syllablesVs
           pairwisePermutations2 :: PermutationsType
pairwisePermutations2 = if Int
cnvArgs forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
3,Int
5,Int
7]  then PermutationsType
pairwisePermutations1 else PermutationsType
pairwisePermutations
           verbose2 :: Int
verbose2 = if Int
verbose1 forall a. Eq a => a -> a -> Bool
== Int
0 then Int
verbose else Int
verbose1
       [Char]
strIntrpr <- [Char] -> [Char] -> IO [Char]
convStringInterpreterIO [Char]
strI1 [Char]
ts
       [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs2 <- (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
fileDu1 then forall (m :: * -> *) a. Monad m => a -> m a
return [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs else [Char] -> IO [[[[Sound8]]] -> [[Double]]]
readSyllableDurations [Char]
fileDu1)
       [[Char]]
wordsNN <-
         if PermutationsType
pairwisePermutations2 forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then do
           [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Char]
messageInfo Int
8 forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian2
           [Char]
mStr <- IO [Char]
getLine
           let m :: Int
m = forall a. a -> Maybe a -> a
fromMaybe Int
10 (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
mStr::Maybe Int) in forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words forall a b. (a -> b) -> a -> b
$ [Char]
strIntrpr
         else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
7 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words forall a b. (a -> b) -> a -> b
$ [Char]
strIntrpr
       [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
generalProc2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs2 [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations2 Bool
recursiveMode Bool
nativeUkrainian2 Bool
interactive Bool
jstL02 [[Char]]
args02 Coeffs2
coeffs2 Coeffs2
coeffsWX2 ([[Char]]
firstArgs forall a. Monoid a => a -> a -> a
`mappend` [[Char]]
wordsNN) Bool
lstW3 Bool
syllables2 Int
syllablesVs2 Int
verbose2

printWarning :: Bool -> String -> IO String
printWarning :: Bool -> [Char] -> IO [Char]
printWarning Bool
nativeUkrainian [Char]
xs = do
  [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Char]
messageInfo Int
3 forall a b. (a -> b) -> a -> b
$ Bool
nativeUkrainian
  [Char] -> IO ()
putStrLn [Char]
xs
  IO [Char]
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]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs ([Int]
intervalNmbrs, [Char]
arg0, Int
numberI, [Char]
choice) Bool
syllables Int
syllablesVs = do
  let bs :: [Char]
bs = [[Char]] -> [Char]
unwords [[Char]]
subs
      sels :: [Sound8]
sels = [Char] -> [Sound8]
parsey0Choice [Char]
choice
  if forall a. Ord a => a -> a -> Ordering
compare Int
numberI Int
2 forall a. Eq a => a -> a -> Bool
== Ordering
LT then let !frep2 :: FuncRep2 ReadyForConstructionUkr Double Double
frep2 = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t forall a. Eq a => a -> a -> Bool
== Char
'w') [Char]
choice then 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
-> [Sound8]
-> [Char]
-> [Char]
-> 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
sDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) forall a. a -> a
id Coeffs2
coeffsWX [Sound8]
sels [Char]
choice [Char]
bs else 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
-> [Sound8]
-> [Char]
-> [Char]
-> 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
sDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) forall a. a -> a
id Coeffs2
coeffs [Sound8]
sels [Char]
choice [Char]
bs
   in forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'G') [Char]
choice then forall (t2 :: * -> *) a b.
(InsertLeft t2 (Result2 a b Double),
 Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
[Char]
-> t2 (Result2 a b Double)
-> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 [Char]
arg0 else 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 (forall a. a -> Maybe a -> a
fromMaybe Int
1 (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
arg0::Maybe Int))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ReadyForConstructionUkr
Str forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        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
' ' forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id [Array Int Int]
perms forall a b. (a -> b) -> a -> b
$ [[Char]]
subs
  else do
    let !variants1 :: [[Char]]
variants1 = 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
' ' forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id [Array Int Int]
perms [[Char]]
subs
        !frep20 :: FuncRep2 ReadyForConstructionUkr Double Double
frep20 = 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
-> [Sound8]
-> [Char]
-> [Char]
-> 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
sDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) forall a. a -> a
id (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t forall a. Eq a => a -> a -> Bool
== Char
'w') [Char]
choice then Coeffs2
coeffsWX else Coeffs2
coeffs) [Sound8]
sels [Char]
choice [Char]
bs
        (!Double
minE,!Double
maxE) = forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, a)
minMax11C forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. FuncRep2 a b c -> a -> b
toPropertiesF'2 FuncRep2 ReadyForConstructionUkr Double Double
frep20) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ReadyForConstructionUkr
Str [[Char]]
variants1
        !frep2 :: FuncRep2 ReadyForConstructionUkr Double Double
frep2 = 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
-> [Sound8]
-> [Char]
-> [Char]
-> 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [[[[Sound8]]] -> [[Double]]]
sDs else [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) (forall b c.
(RealFrac b, Integral c, Ord c) =>
b -> b -> c -> [c] -> b -> b
unsafeSwapVecIWithMaxI Double
minE Double
maxE Int
numberI [Int]
intervalNmbrs) (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t forall a. Eq a => a -> a -> Bool
== Char
'w') [Char]
choice then Coeffs2
coeffsWX else Coeffs2
coeffs) [Sound8]
sels [Char]
choice [Char]
bs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'G') [Char]
choice then forall (t2 :: * -> *) a b.
(InsertLeft t2 (Result2 a b Double),
 Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
[Char]
-> t2 (Result2 a b Double)
-> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 [Char]
arg0 else 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 (forall a. a -> Maybe a -> a
fromMaybe Int
1 (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
arg0::Maybe Int))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep2) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ReadyForConstructionUkr
Str [[Char]]
variants1

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

print2 :: p -> [Result2 ReadyForConstructionUkr a a] -> IO ()
print2 p
verbose = [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a} {p}.
(Show a, Show a, Num p, Ord a, Ord a, Eq p) =>
p -> [Result2 ReadyForConstructionUkr a a] -> [Char]
show2 p
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
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [([Int], [Char], Int, [Char])]
-> [Array Int Int]
-> [[Char]]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
generalProcMMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactiveMM Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [([Int], [Char], Int, [Char])]
rs [Array Int Int]
perms [[Char]]
subs [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose =
 case forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Int], [Char], Int, [Char])]
rs of
  Int
0 -> [Char] -> IO ()
putStrLn (Int -> Bool -> [Char]
messageInfo Int
4 Bool
nativeUkrainian) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionUkr
Str [],[])
  Int
1 -> [Char] -> IO ()
putStrLn (Int -> Bool -> [Char]
messageInfo Int
5 Bool
nativeUkrainian) 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]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs (forall a. [a] -> a
head [([Int], [Char], Int, [Char])]
rs) Bool
syllables Int
syllablesVs
        if Int
verbose forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1..Int
3] then forall {a} {a} {p}.
(Show a, Show a, Num p, Ord a, Ord a, Eq p) =>
p -> [Result2 ReadyForConstructionUkr a a] -> IO ()
print2 Int
verbose [Result2 ReadyForConstructionUkr Double Double]
temp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO ()
putStrLn [Char]
"" else [Char] -> IO ()
putStr [Char]
""
        forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
finalProc [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactiveMM Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL ([[Char]] -> [Char]
unwords [[Char]]
args) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionUkr Double Double]
temp [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
  Int
_ -> do
         [[Result2 ReadyForConstructionUkr Double Double]]
genVariants <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\([Int], [Char], Int, [Char])
k -> [[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> Bool
-> Int
-> IO [Result2 ReadyForConstructionUkr Double Double]
generalProcMs [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs ([Int], [Char], Int, [Char])
k Bool
syllables Int
syllablesVs) [([Int], [Char], Int, [Char])]
rs
         if Int
verbose forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1..Int
3] then forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Result2 ReadyForConstructionUkr Double Double]
t -> forall {a} {a} {p}.
(Show a, Show a, Num p, Ord a, Ord a, Eq p) =>
p -> [Result2 ReadyForConstructionUkr a a] -> IO ()
print2 Int
verbose [Result2 ReadyForConstructionUkr Double Double]
t forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO ()
putStrLn [Char]
"") [[Result2 ReadyForConstructionUkr Double Double]]
genVariants else [Char] -> IO ()
putStr [Char]
""
         forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
finalProc [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactiveMM Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX ([Char] -> ReadyForConstructionUkr -> [Char]
convFSL ([[Char]] -> [Char]
unwords [[Char]]
args)) ([Char] -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI ([[Char]] -> [Char]
unwords [[Char]]
args) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b c. Result2 a b c -> a
line2) forall a b. (a -> b) -> a -> b
$ [[Result2 ReadyForConstructionUkr Double Double]]
genVariants) [[Char]]
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 :: forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
finalProc [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX a -> [Char]
f [a]
xss [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | Bool
recursiveMode = forall a.
[[[[Sound8]]] -> [[Double]]]
-> [[[[Sound8]]] -> [[Double]]]
-> PermutationsType
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResultRecursive [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs [[[[Sound8]]] -> [[Double]]]
sDs PermutationsType
pairwisePermutations Bool
recursiveMode Bool
nativeUkrainian Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX a -> [Char]
f [a]
xss [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | Bool
interactive = forall a.
Bool
-> (a -> [Char])
-> [a]
-> Bool
-> Int
-> IO (ReadyForConstructionUkr, [Char])
interactivePrintResult Bool
nativeUkrainian a -> [Char]
f [a]
xss Bool
syllables Int
syllablesVs
 | Bool
otherwise = [Char] -> IO ()
putStrLn [Char]
ts forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionUkr
Str [Char]
ts,[Char]
ts)
  where ts :: [Char]
ts = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
t -> a -> [Char]
f a
t forall a. Monoid a => a -> a -> a
`mappend` [Char]
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
-> [Char]
-> [Result2 ReadyForConstructionUkr Double Double]
-> IO (ReadyForConstructionUkr, [Char])
print1el Bool
jstlines [Char]
choice [Result2 ReadyForConstructionUkr Double Double]
y
 | Bool
jstlines forall a. Eq a => a -> a -> Bool
== Bool
True = [Char] -> IO ()
putStrLn [Char]
us forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionUkr
Str [Char]
us,[Char]
us)
 | Bool
otherwise = [Char] -> IO ()
putStrLn [Char]
zs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionUkr
Str [Char]
zs,[Char]
zs)
       where !ch :: Maybe Int
ch = [Char] -> Maybe Int
precChoice [Char]
choice
             !us :: [Char]
us = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Result2 ReadyForConstructionUkr Double Double
ys -> ReadyForConstructionUkr -> [Char]
showR (forall a b c. Result2 a b c -> a
line2 Result2 ReadyForConstructionUkr Double Double
ys) forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding) [Result2 ReadyForConstructionUkr Double Double]
y

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