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

-- |
-- Module      :  Phonetic.Languages.General.Simple
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Library module that contains functions earlier used by the lineVariantsG3
-- executable for the Ukrainian language (see: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array).
-- Is rewritten from the Phonetic.Languages.Simple module from the
-- @phonetic-languages-simplified-examples-array@ package.

module Phonetic.Languages.General.Simple where

import Phonetic.Languages.General.Parsing
import Numeric
import Languages.UniquenessPeriods.Array.Constraints.Encoded (decodeLConstraints,readMaybeECG)
import GHC.Arr
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Basis
import Phonetic.Languages.Simplified.DataG.Partir
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI)
import Phonetic.Languages.Simplified.StrictVG.Base
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.PrepareText
import Data.Char
import qualified Data.List  as L (span,sort,zip4,isPrefixOf,nub,sortBy,intersperse)
import Phonetic.Languages.Simplified.Array.General.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.General.DeEnCoding
import Phonetic.Languages.General.SimpleConstraints
import Phonetic.Languages.General.Common
import Data.Phonetic.Languages.Syllables
import Interpreter.StringConversion
import Interpreter.ArgsConversion
import qualified Phonetic.Languages.Permutations.Represent as R
import Phonetic.Languages.EmphasisG
import CaseBi.Arr (getBFstLSorted')
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
 :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> (String -> Bool) -- ^ The predicate that checks whether the given argument is not a phonetic language word in the representation.
 -> [String]
 -> String -- ^ If empty, the function is just 'generalProc2G' with the arguments starting from the first 'Bool' here.
 -> Int
 -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL]  -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> String
 -> FilePath
 -> Bool -- ^ Whether to run in the recursive mode.
 -> Bool
 -> Bool
 -> [String]
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> [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
 -> (String -> String)  -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
 -> IO ()
generalProc3G :: PermutationsType
-> ([Char] -> Bool)
-> [[Char]]
-> [Char]
-> Int
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO ()
generalProc3G PermutationsType
pairwisePermutations [Char] -> Bool
p [[Char]]
textProcessmentFss [Char]
textProcessment0 Int
textProcessment1 GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss [Char]
ws [Char]
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
textProcessment0 = PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss [Char]
ws [Char]
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[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 -> [Char]
messageInfo forall a b. (a -> b) -> a -> b
$ Int
7
    [Char]
lineA <- IO [Char]
getLine
    PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss [Char]
ws [Char]
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0
      (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
p [Char]
lineA [[Char]]
args0) Coeffs2
coeffs Coeffs2
coeffsWX (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
p [Char]
lineA [[Char]]
args)
      Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1) [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
R.P Int
0 then do
          let !wss :: [[Char]]
wss
                | Int
textProcessment1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
10,Int
20,Int
30,Int
40,Int
50,Int
60,Int
70,Int
80,Int
90] = [[Char]]
kss
                | Bool
otherwise = Int
-> Int
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> [[Char]]
prepareTuneTextMN Int
m Int
1 Concatenations
ysss Concatenations
zzzsss [Char]
ws 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 -> PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss [Char]
ws [Char]
toFile1 Bool
recursiveMode
                 Bool
interactive Bool
jstL0 (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
p [Char]
tss [[Char]]
args0) Coeffs2
coeffs Coeffs2
coeffsWX
                  (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
p [Char]
tss [[Char]]
args) Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1) [[Char]]
wss
        else do
          let !wss :: [[Char]]
wss
               | Int
textProcessment1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
20,Int
30,Int
40,Int
50,Int
60,Int
70] = [[Char]]
kss
               | Bool
otherwise = Int
-> Int
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> [[Char]]
prepareTuneTextMN (if Int
textProcessment1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
21,Int
31,Int
41,Int
51,Int
61] then Int
m else Int
7) Int
1 Concatenations
ysss Concatenations
zzzsss [Char]
ws 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 -> PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss [Char]
ws [Char]
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0
                 (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
p [Char]
tss [[Char]]
args0) Coeffs2
coeffs Coeffs2
coeffsWX
                  (([Char] -> Bool) -> [Char] -> [[Char]] -> [[Char]]
fullArgsConvertTextualSimple [Char] -> Bool
p [Char]
tss [[Char]]
args) Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1) [[Char]]
wss) [[Char]]
textProcessmentFss
     where 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

-- | Is used to do general processment.
generalProc2G
 :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL]  -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> String
 -> FilePath
 -> Bool -- ^ Whether to run in the recursive mode.
 -> Bool
 -> Bool
 -> [String]
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> [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 
 -> (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
 -> IO ()
generalProc2G :: PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss [Char]
ws [Char]
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1
 | [[Char]] -> Bool
variations [[Char]]
args = do
    let !zsss :: Concatenations
zsss = [[Char]] -> Concatenations
transformToVariations [[Char]]
args
    [(ReadyForConstructionPL, [Char])]
variantsG <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[[Char]]
xss -> PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
generalProc2 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [] Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
xss Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1) Concatenations
zsss
    if Bool
interactive then do
         (if Bool
recursiveMode then forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [] Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (ReadyForConstructionPL -> [Char]
showR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) 
             [(ReadyForConstructionPL, [Char])]
variantsG [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1 else forall a.
(a -> [Char])
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, [Char])
interactivePrintResult (ReadyForConstructionPL -> [Char]
showR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ReadyForConstructionPL, [Char])]
variantsG Bool
syllables Int
syllablesVs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ReadyForConstructionPL
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 (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
cs ReadyForConstructionPL
rs forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding)
    else forall (m :: * -> *) a. Monad m => a -> m a
return ()
 | Bool
otherwise = PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
generalProc2 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [] Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ReadyForConstructionPL
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 (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
cs ReadyForConstructionPL
rs forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding)

-- |
generalProc2
  :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String
  -> String
  -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
  -> [MappingFunctionPL]  -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
  -> [MappingFunctionPL] 
  -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to
  -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
  -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to
  -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
  -> String
  -> Bool -- ^ Whether to run in the recursive mode.
  -> Bool
  -> Bool
  -> [String]
  -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
  -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
  -> [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
  -> (String ->  String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
  -> IO (ReadyForConstructionPL, String)
generalProc2 :: PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
generalProc2 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1 = 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
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> [[Char]]
prepareTuneTextMN (if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
R.P Int
0 then Int
10 else Int
7) Int
1 Concatenations
ysss Concatenations
zzzsss [Char]
ws 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 :: ReadyForConstructionPL
xs = [Char] -> ReadyForConstructionPL
StrG [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 :: [Char]
sels = ([Char] -> [Char]) -> [Char] -> [Char]
parsey0Choice [Char] -> [Char]
g1 [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 GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> Int
-> Bool
-> [Char]
-> IO
     ([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
      ReadyForConstructionPL)
weightsString3NIO GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs 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] -> ReadyForConstructionPL
StrG [])) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \([[FlowSoundG]]
syllDs,[[[[Int8]]] -> [[Double]]]
syllableDs,ReadyForConstructionPL
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 ReadyForConstructionPL Double Double
frep20 = forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> c)
-> (Double -> [Char] -> MappingFunctionPL)
-> Coeffs2
-> [Char]
-> [MappingFunctionPL]
-> [Char]
-> [Char]
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs forall a. a -> a
id Double -> [Char] -> MappingFunctionPL
h (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) [Char]
sels (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
qs) [Char]
choice [Char]
bs in let !wwss :: [Result2 ReadyForConstructionPL 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 ReadyForConstructionPL Double Double
frep20 forall a b. (a -> b) -> a -> b
$ ReadyForConstructionPL
xs in
    if Bool
recursiveMode then forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs  (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
wwss [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1
    else if Bool
interactive then forall a.
(a -> [Char])
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, [Char])
interactivePrintResult (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
wwss Bool
syllables Int
syllablesVs else Bool
-> [Char]
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, [Char])
print1el Bool
jstL0 [Char]
choice [Result2 ReadyForConstructionPL 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
' 'forall a. a -> [a] -> [a]
:[Char]
js forall a. Monoid a => a -> a -> a
`mappend` [Char]
vs) [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
R.P Int
2 = Int -> [Array Int Int]
genPairwisePermutationsLN Int
l
                              | PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
R.P Int
1 = Int -> [Array Int Int]
genElementaryPermutationsLN1 Int
l
                              | Bool
otherwise = Int -> [Array Int Int]
genPermutationsL Int
l in do
          [Result2 ReadyForConstructionPL Double Double]
temp <- GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> ([Char] -> [Char])
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs ([Int]
intervalNmbrs, [Char]
arg0, Int
numberI, [Char]
choice) [Char] -> [Char]
g1
          if Bool
recursiveMode then forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
temp [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1
          else if Bool
interactive then forall a.
(a -> [Char])
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, [Char])
interactivePrintResult (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
temp Bool
syllables Int
syllablesVs else Bool
-> [Char]
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, [Char])
print1el Bool
jstL0 [Char]
choice [Result2 ReadyForConstructionPL Double Double]
temp
    else do
     [Char]
correct <- [Char] -> IO [Char]
printWarning [Char]
bs
     if [Char]
correct forall a. Eq a => a -> a -> Bool
== [Char]
"n" then [Char] -> IO ()
putStrLn (Int -> [Char]
messageInfo Int
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionPL
StrG [Char]
"",[Char]
"") -- 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
R.P Int
2 then Int -> [Array Int Int]
genPairwisePermutationsLN else if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
R.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 ReadyForConstructionPL Double Double]
temp <- GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> ([Char] -> [Char])
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs  (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs ([Int]
intervalNmbrs, [Char]
arg0, Int
numberI, [Char]
choice) [Char] -> [Char]
g1
          if Bool
recursiveMode then forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
temp [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1
          else if Bool
interactive then forall a.
(a -> [Char])
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, [Char])
interactivePrintResult (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
temp Bool
syllables Int
syllablesVs else Bool
-> [Char]
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, [Char])
print1el Bool
jstL0 [Char]
choice [Result2 ReadyForConstructionPL 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 :: Concatenations
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) Concatenations
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)) Concatenations
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
$ Concatenations
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
-> Concatenations
-> Concatenations
-> [Char]
-> [Char]
-> [[Char]]
prepareTuneTextMN (if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
R.P Int
0 then Int
10 else Int
7) Int
1 Concatenations
ysss Concatenations
zzzsss [Char]
ws forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ [[Char]]
args
       !xs :: ReadyForConstructionPL
xs = [Char] -> ReadyForConstructionPL
StrG [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)
   ([[FlowSoundG]]
syllDs,[[[[Int8]]] -> [[Double]]]
syllableDs,ReadyForConstructionPL
readys) <- do if Bool
syllables then GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> Int
-> Bool
-> [Char]
-> IO
     ([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
      ReadyForConstructionPL)
weightsString3NIO  GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs 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 ([],[],[[[Int8]]] -> ReadyForConstructionPL
FSLG [])
   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 ReadyForConstructionPL Double Double
frep20 = forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> c)
-> (Double -> [Char] -> MappingFunctionPL)
-> Coeffs2
-> [Char]
-> [MappingFunctionPL]
-> [Char]
-> [Char]
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs forall a. a -> a
id Double -> [Char] -> MappingFunctionPL
h Coeffs2
coeffs [] (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 forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
qs) (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 in
    let !wwss :: [Result2 ReadyForConstructionPL 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 ReadyForConstructionPL Double Double
frep20 forall a b. (a -> b) -> a -> b
$ ReadyForConstructionPL
xs in
       if Bool
recursiveMode then forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs (if Bool
syllables then forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
wwss [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1
       else if Bool
interactive then forall a.
(a -> [Char])
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, [Char])
interactivePrintResult (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs [Char]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
wwss Bool
syllables Int
syllablesVs
            else Bool
-> [Char]
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, [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 ReadyForConstructionPL 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
' 'forall a. a -> [a] -> [a]
:[Char]
js forall a. Monoid a => a -> a -> a
`mappend` [Char]
vs) [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
R.P Int
2 = Int -> [Array Int Int]
genPairwisePermutationsLN Int
l
                             | PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
R.P Int
1 = Int -> [Array Int Int]
genElementaryPermutationsLN1 Int
l
                             | Bool
otherwise = Int -> [Array Int Int]
genPermutationsL Int
l in
      PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [([Int], [Char], Int, [Char])]
-> [Array Int Int]
-> [[Char]]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
generalProcMMs PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs (forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs) Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode 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 [Char] -> [Char]
g1
    else do
     [Char]
correct <- [Char] -> IO [Char]
printWarning [Char]
bs
     if [Char]
correct forall a. Eq a => a -> a -> Bool
== [Char]
"n" then [Char] -> IO ()
putStrLn (Int -> [Char]
messageInfo Int
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionPL
StrG [Char]
"",[Char]
"") -- 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
. (case PermutationsType
pairwisePermutations of {R.P Int
2 -> Int -> [Array Int Int]
genPairwisePermutationsLN ; R.P Int
1 -> Int -> [Array Int Int]
genElementaryPermutationsLN1 ; ~PermutationsType
rrr -> Int -> [Array Int Int]
genPermutationsL}) forall a b. (a -> b) -> a -> b
$ Int
l in
            PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [([Int], [Char], Int, [Char])]
-> [Array Int Int]
-> [[Char]]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
generalProcMMs PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs (forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs) Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode 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 [Char] -> [Char]
g1

-- | Function provides message information.
messageInfo :: Int -> String
messageInfo :: Int -> [Char]
messageInfo Int
n
 | 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. "

-- |
interactivePrintResult 
 :: (a -> String) 
 -> [a] 
 -> Bool
 -> Int
 -> IO (ReadyForConstructionPL,String)
interactivePrintResult :: forall a.
(a -> [Char])
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, [Char])
interactivePrintResult 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 -> [Char]
messageInfo forall a b. (a -> b) -> a -> b
$ Int
5) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionPL
StrG [Char]
"",[Char]
"")
  | 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
     if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
datas then ([Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
messageInfo forall a b. (a -> b) -> a -> b
$ Int
5) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionPL
StrG [Char]
"",[Char]
"")
     else do
      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 -> [Char]
messageInfo forall a b. (a -> b) -> a -> b
$ Int
2
      [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] -> ReadyForConstructionPL
StrG [Char]
ts,[Char]
ts)

interactivePrintResultRecursive
 :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
 -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL]  -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> [MappingFunctionPL]
 -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> String
 -> Bool -- ^ Whether to run in the recursive mode.
 -> 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
 -> (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
 -> IO (ReadyForConstructionPL,String)
interactivePrintResultRecursive :: forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode 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 [Char] -> [Char]
g1
  | 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 -> [Char]
messageInfo forall a b. (a -> b) -> a -> b
$ Int
5) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionPL
StrG [Char]
"",[Char]
"")
  | 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 -> [Char]
messageInfo forall a b. (a -> b) -> a -> b
$ Int
2
     [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 -> [Char]
messageInfo forall a b. (a -> b) -> a -> b
$ Int
6
     [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] -> ReadyForConstructionPL
StrG [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]
_,PermutationsType
pairwisePermutations1,Bool
_,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
           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
       [[Char]]
wordsNN <-
         if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
R.P Int
0 then do
           [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
messageInfo forall a b. (a -> b) -> a -> b
$ Int
8
           [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
       PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
generalProc2 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX ([[Char]]
firstArgs forall a. Monoid a => a -> a -> a
`mappend` [[Char]]
wordsNN) Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1

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

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

print2 :: p -> [Result2 ReadyForConstructionPL 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 ReadyForConstructionPL a a] -> [Char]
show2 p
verbose

generalProcMs
 :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL]  -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> [MappingFunctionPL]
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> [Array Int Int]  -- ^ Permutations data.
 -> [String]
 -> ([Int],String,Int,String) -- ^ The 'String' is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one (that is the default one). Since 0.5.0.0 version can also
 -- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions.
 -- @ since 0.6.0.0
 -- Changed the arguments signing so that capital letters changed to the small ones, double ++ changed to just singular +.
 -> (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
 -> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> ([Char] -> [Char])
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs ([Int]
intervalNmbrs, [Char]
arg0, Int
numberI, [Char]
choice) [Char] -> [Char]
g1 = do
  let bs :: [Char]
bs = [[Char]] -> [Char]
unwords [[Char]]
subs
      sels :: [Char]
sels = ([Char] -> [Char]) -> [Char] -> [Char]
parsey0Choice [Char] -> [Char]
g1 [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 ReadyForConstructionPL Double Double
frep2 =  forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> c)
-> (Double -> [Char] -> MappingFunctionPL)
-> Coeffs2
-> [Char]
-> [MappingFunctionPL]
-> [Char]
-> [Char]
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs forall a. a -> a
id Double -> [Char] -> MappingFunctionPL
h (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t forall a. Eq a => a -> a -> Bool
== Char
'w' Bool -> Bool -> Bool
|| Char
t forall a. Eq a => a -> a -> Bool
== Char
'x') [Char]
choice then Coeffs2
coeffsWX else Coeffs2
coeffs) [Char]
sels (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [MappingFunctionPL]
sDs else [MappingFunctionPL]
qs) [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 ReadyForConstructionPL Double Double
frep2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ReadyForConstructionPL
StrG 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 ReadyForConstructionPL Double Double
frep20 = forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> c)
-> (Double -> [Char] -> MappingFunctionPL)
-> Coeffs2
-> [Char]
-> [MappingFunctionPL]
-> [Char]
-> [Char]
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs forall a. a -> a
id Double -> [Char] -> MappingFunctionPL
h (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) [Char]
sels (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [MappingFunctionPL]
sDs else [MappingFunctionPL]
qs) [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 ReadyForConstructionPL Double Double
frep20) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ReadyForConstructionPL
StrG [[Char]]
variants1
        !frep2 :: FuncRep2 ReadyForConstructionPL Double Double
frep2 = forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> c)
-> (Double -> [Char] -> MappingFunctionPL)
-> Coeffs2
-> [Char]
-> [MappingFunctionPL]
-> [Char]
-> [Char]
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs (forall b c.
(RealFrac b, Integral c, Ord c) =>
b -> b -> c -> [c] -> b -> b
unsafeSwapVecIWithMaxI Double
minE Double
maxE Int
numberI [Int]
intervalNmbrs) Double -> [Char] -> MappingFunctionPL
h 
           (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) [Char]
sels (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice then [MappingFunctionPL]
sDs else [MappingFunctionPL]
qs) [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 ReadyForConstructionPL Double Double
frep2) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ReadyForConstructionPL
StrG [[Char]]
variants1

-- |
generalProcMMs
 :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL]  -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> [MappingFunctionPL]
 -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> String
 -> Bool -- ^ Whether to run in the recursive mode.
 -> Bool
 -> Bool
 -> [String]
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> [([Int],String,Int,String)] -- ^ The 'String' is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one (that is the default one). Since 0.5.0.0 version can also
 -- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions.
 -- @ since 0.6.0.0
 -- Changed the arguments signing so that capital letters changed to the small ones, double ++ changed to just singular +.
 -> [Array Int Int] -- ^ Permutations data.
 -> [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
 -> (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
 -> IO (ReadyForConstructionPL, String)
generalProcMMs :: PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> [([Int], [Char], Int, [Char])]
-> [Array Int Int]
-> [[Char]]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
generalProcMMs PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode 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 [Char] -> [Char]
g1 =
 case forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Int], [Char], Int, [Char])]
rs of
  Int
0 -> [Char] -> IO ()
putStrLn (Int -> [Char]
messageInfo Int
4) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReadyForConstructionPL
StrG [Char]
"",[Char]
"")
  Int
1 -> [Char] -> IO ()
putStrLn (Int -> [Char]
messageInfo Int
5) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
        [Result2 ReadyForConstructionPL Double Double]
temp <- GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> ([Char] -> [Char])
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs (forall a. [a] -> a
head [([Int], [Char], Int, [Char])]
rs) [Char] -> [Char]
g1
        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 ReadyForConstructionPL a a] -> IO ()
print2 Int
verbose [Result2 ReadyForConstructionPL 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.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
finalProc PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactiveMM Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs ([[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 ReadyForConstructionPL Double Double]
temp [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1
  Int
_ -> do
         [[Result2 ReadyForConstructionPL 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-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [[Char]]
-> ([Int], [Char], Int, [Char])
-> ([Char] -> [Char])
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [[Char]]
subs ([Int], [Char], Int, [Char])
k [Char] -> [Char]
g1) [([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 ReadyForConstructionPL Double Double]
t -> forall {a} {a} {p}.
(Show a, Show a, Num p, Ord a, Ord a, Eq p) =>
p -> [Result2 ReadyForConstructionPL a a] -> IO ()
print2 Int
verbose [Result2 ReadyForConstructionPL Double Double]
t forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO ()
putStrLn [Char]
"") [[Result2 ReadyForConstructionPL Double Double]]
genVariants else [Char] -> IO ()
putStr [Char]
""
         forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
finalProc PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode Bool
interactiveMM Bool
jstL0 [[Char]]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> [Char]
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs ([[Char]] -> [Char]
unwords [[Char]]
args)) (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> [Char]
-> [[ReadyForConstructionPL]]
-> [ReadyForConstructionPL]
foldlI GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs ([[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 ReadyForConstructionPL Double Double]]
genVariants) [[Char]]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose [Char] -> [Char]
g1

-- |
finalProc
 :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL]  -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> [MappingFunctionPL]
 -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> String
 -> Bool -- ^ Whether to run in the recursive mode.
 -> 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
 -> (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
 -> IO (ReadyForConstructionPL,String)
finalProc :: forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
finalProc  PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode 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 [Char] -> [Char]
g1
 | Bool
recursiveMode = forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> [Char]
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Coeffs2
-> Coeffs2
-> (a -> [Char])
-> [a]
-> [[Char]]
-> Bool
-> Bool
-> Int
-> Int
-> ([Char] -> [Char])
-> IO (ReadyForConstructionPL, [Char])
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs [Char]
js [Char]
vs Double -> [Char] -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss [Char]
ws Bool
recursiveMode 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 [Char] -> [Char]
g1
 | Bool
otherwise = if Bool
interactive then forall a.
(a -> [Char])
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, [Char])
interactivePrintResult a -> [Char]
f [a]
xss Bool
syllables Int
syllablesVs else [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] -> ReadyForConstructionPL
StrG [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

-- |
print1el :: Bool -> String -> [Result2 ReadyForConstructionPL Double Double] -> IO (ReadyForConstructionPL,String)
print1el :: Bool
-> [Char]
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, [Char])
print1el Bool
jstlines [Char]
choice [Result2 ReadyForConstructionPL 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] -> ReadyForConstructionPL
StrG [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] -> ReadyForConstructionPL
StrG [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 ReadyForConstructionPL Double Double
ys -> ReadyForConstructionPL -> [Char]
showR (forall a b c. Result2 a b c -> a
line2 Result2 ReadyForConstructionPL Double Double
ys) forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding) [Result2 ReadyForConstructionPL Double Double]
y
             !zs :: [Char]
zs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Result2 ReadyForConstructionPL Double Double
ys -> ReadyForConstructionPL -> [Char]
showR (forall a b c. Result2 a b c -> a
line2 Result2 ReadyForConstructionPL 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 ReadyForConstructionPL 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 ReadyForConstructionPL Double Double
ys) [Char]
newLineEnding)) [Result2 ReadyForConstructionPL Double Double]
y