{-# 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 (isDigit,isAlpha,isLetter)
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 qualified Phonetic.Languages.Permutations.Represent as R
import Phonetic.Languages.EmphasisG
import CaseBi.Arr (getBFstLSorted')

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

{-| Is used to organize the most complex processment -- for multiple sources and probably recursively.
-}
generalProc3G
 :: 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
 -> IO ()
generalProc3G :: PermutationsType
-> (String -> Bool)
-> [String]
-> String
-> Int
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc3G PermutationsType
pairwisePermutations String -> Bool
p [String]
textProcessmentFss String
textProcessment0 Int
textProcessment1 GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss String
ws String
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
textProcessment0 = PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss String
ws String
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
textProcessmentFss = (Integer -> IO ()) -> [Integer] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Integer
_ -> do  -- interactive training mode
    String -> IO ()
putStrLn (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
messageInfo (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
7
    String
lineA <- IO String
getLine
    PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss String
ws String
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0
      ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
p String
lineA [String]
args0) Coeffs2
coeffs Coeffs2
coeffsWX ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
p String
lineA [String]
args)
      Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose) [Integer
0..]
 | Bool
otherwise =
      (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
js -> do
        let !kss :: [String]
kss = String -> [String]
lines String
js
        if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
R.P Int
0 then do
          let !wss :: [String]
wss
                | Int
textProcessment1 Int -> [Int] -> Bool
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] = [String]
kss
                | Bool
otherwise = Int
-> Int
-> Concatenations
-> Concatenations
-> String
-> String
-> [String]
prepareTuneTextMN Int
m Int
1 Concatenations
ysss Concatenations
zzzsss String
ws (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
kss
          (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
tss -> PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss String
ws String
toFile1 Bool
recursiveMode
                 Bool
interactive Bool
jstL0 ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
p String
tss [String]
args0) Coeffs2
coeffs Coeffs2
coeffsWX
                  ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
p String
tss [String]
args) Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose) [String]
wss
        else do
          let !wss :: [String]
wss
               | Int
textProcessment1 Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
20,Int
30,Int
40,Int
50,Int
60,Int
70] = [String]
kss
               | Bool
otherwise = Int
-> Int
-> Concatenations
-> Concatenations
-> String
-> String
-> [String]
prepareTuneTextMN (if Int
textProcessment1 Int -> [Int] -> Bool
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 String
ws (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
kss
          (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
tss -> PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss String
ws String
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0
                 ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
p String
tss [String]
args0) Coeffs2
coeffs Coeffs2
coeffsWX
                  ((String -> Bool) -> String -> [String] -> [String]
fullArgsConvertTextualSimple String -> Bool
p String
tss [String]
args) Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose) [String]
wss) [String]
textProcessmentFss
     where m :: Int
m = if Int
textProcessment1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
10 Bool -> Bool -> Bool
|| Int
textProcessment1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
11 then Int
10 else Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
textProcessment1 Int
10

-- | 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 
 -> IO ()
generalProc2G :: PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO ()
generalProc2G PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss String
ws String
toFile1 Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | [String] -> Bool
variations [String]
args = do
    let !zsss :: Concatenations
zsss = [String] -> Concatenations
transformToVariations [String]
args
    [(ReadyForConstructionPL, String)]
variantsG <- ([String] -> IO (ReadyForConstructionPL, String))
-> Concatenations -> IO [(ReadyForConstructionPL, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[String]
xss -> PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
generalProc2 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [] Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
xss Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose) Concatenations
zsss
    if Bool
interactive then do
         (if Bool
recursiveMode then PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> ((ReadyForConstructionPL, String) -> String)
-> [(ReadyForConstructionPL, String)]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [] Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (ReadyForConstructionPL -> String
showR (ReadyForConstructionPL -> String)
-> ((ReadyForConstructionPL, String) -> ReadyForConstructionPL)
-> (ReadyForConstructionPL, String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL, String) -> ReadyForConstructionPL
forall a b. (a, b) -> a
fst) 
             [(ReadyForConstructionPL, String)]
variantsG [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose else ((ReadyForConstructionPL, String) -> String)
-> [(ReadyForConstructionPL, String)]
-> Bool
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
(a -> String)
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, String)
interactivePrintResult (ReadyForConstructionPL -> String
showR (ReadyForConstructionPL -> String)
-> ((ReadyForConstructionPL, String) -> ReadyForConstructionPL)
-> (ReadyForConstructionPL, String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL, String) -> ReadyForConstructionPL
forall a b. (a, b) -> a
fst) [(ReadyForConstructionPL, String)]
variantsG Bool
syllables Int
syllablesVs) IO (ReadyForConstructionPL, String)
-> ((ReadyForConstructionPL, String) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ReadyForConstructionPL
rs,String
cs) ->
           case String
toFile1 of
            String
"" -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            ~String
fileName -> String -> String -> IO ()
appendFile String
fileName (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
cs ReadyForConstructionPL
rs String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding)
    else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 | Bool
otherwise = PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
generalProc2 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [] Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose IO (ReadyForConstructionPL, String)
-> ((ReadyForConstructionPL, String) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ReadyForConstructionPL
rs,String
cs) ->
      case String
toFile1 of
       String
"" -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       ~String
fileName -> String -> String -> IO ()
appendFile String
fileName (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
cs ReadyForConstructionPL
rs String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
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
  -> IO (ReadyForConstructionPL, String)
generalProc2 :: PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
generalProc2 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose = do
 let !argMss :: [(String, [String])]
argMss = Int -> [(String, [String])] -> [(String, [String])]
forall a. Int -> [a] -> [a]
take Int
5 ([(String, [String])] -> [(String, [String])])
-> ([String] -> [(String, [String])])
-> [String]
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [String]) -> Bool)
-> [(String, [String])] -> [(String, [String])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, [String]) -> Bool) -> (String, [String]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [String]) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([(String, [String])] -> [(String, [String])])
-> ([String] -> [(String, [String])])
-> [String]
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(String, [String])]
forMultiplePropertiesF ([String] -> [(String, [String])])
-> ([String] -> [String]) -> [String] -> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+m") ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-m") ([String] -> [(String, [String])])
-> [String] -> [(String, [String])]
forall a b. (a -> b) -> a -> b
$ [String]
args0
 if [(String, [String])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [String])]
argMss then do
  let (![String]
numericArgs,![String]
textualArgs) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ [String]
args
      !bs :: String
bs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> Concatenations
-> Concatenations
-> String
-> String
-> [String]
prepareTuneTextMN (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
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 String
ws (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
textualArgs
      !xs :: ReadyForConstructionPL
xs = String -> ReadyForConstructionPL
StrG String
bs
      !l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
bs
      !argCs :: [EncodedCnstrs]
argCs = [Maybe EncodedCnstrs] -> [EncodedCnstrs]
forall a. [Maybe a] -> [a]
catMaybes ((String -> Maybe EncodedCnstrs)
-> [String] -> [Maybe EncodedCnstrs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> Maybe EncodedCnstrs
readMaybeECG (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([String] -> [Maybe EncodedCnstrs])
-> ([String] -> [String]) -> [String] -> [Maybe EncodedCnstrs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool -> String
showB Int
l Bool
lstW2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+a") ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-a") ([String] -> [Maybe EncodedCnstrs])
-> [String] -> [Maybe EncodedCnstrs]
forall a b. (a -> b) -> a -> b
$ [String]
args0)
      !arg0 :: String
arg0 = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
numericArgs
      !numberI :: Int
numberI = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
numericArgs)::Maybe Int)
      !choice :: String
choice = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
textualArgs
      !intervalNmbrs :: [Int]
intervalNmbrs = (\[Int]
zs -> if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
zs then [Int
numberI] else [Int] -> [Int]
forall a. Eq a => [a] -> [a]
L.nub [Int]
zs) ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
numberI) ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\String
t -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
numberI (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
t::Maybe Int)) ([String] -> [Int]) -> ([String] -> [String]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> [Int]) -> [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ [String]
numericArgs
  (if Bool
syllables then do GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Int
-> Bool
-> String
-> IO
     ([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
      ReadyForConstructionPL)
weightsString3NIO GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Int
syllablesVs ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice) String
bs else ([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
 ReadyForConstructionPL)
-> IO
     ([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
      ReadyForConstructionPL)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],String -> ReadyForConstructionPL
StrG [])) IO
  ([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
   ReadyForConstructionPL)
-> (([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
     ReadyForConstructionPL)
    -> IO (ReadyForConstructionPL, String))
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \([[FlowSoundG]]
syllDs,[[[[Int8]]] -> [[Double]]]
syllableDs,ReadyForConstructionPL
readys) -> do
   if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then let !frep20 :: FuncRep2 ReadyForConstructionPL Double Double
frep20 = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t  Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w') String
choice then Coeffs2
coeffsWX else Coeffs2
coeffs) (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then (([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
qs) String
choice String
bs in let !wwss :: [Result2 ReadyForConstructionPL Double Double]
wwss = (Result2 ReadyForConstructionPL Double Double
-> [Result2 ReadyForConstructionPL Double Double]
-> [Result2 ReadyForConstructionPL Double Double]
forall a. a -> [a] -> [a]
:[]) (Result2 ReadyForConstructionPL Double Double
 -> [Result2 ReadyForConstructionPL Double Double])
-> (ReadyForConstructionPL
    -> Result2 ReadyForConstructionPL Double Double)
-> ReadyForConstructionPL
-> [Result2 ReadyForConstructionPL Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncRep2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
-> Result2 ReadyForConstructionPL Double Double
forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionPL Double Double
frep20 (ReadyForConstructionPL
 -> [Result2 ReadyForConstructionPL Double Double])
-> ReadyForConstructionPL
-> [Result2 ReadyForConstructionPL Double Double]
forall a b. (a -> b) -> a -> b
$ ReadyForConstructionPL
xs in
    if Bool
recursiveMode then PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs  (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then (([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
bs (ReadyForConstructionPL -> String)
-> (Result2 ReadyForConstructionPL Double Double
    -> ReadyForConstructionPL)
-> Result2 ReadyForConstructionPL Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
wwss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
    else if Bool
interactive then (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double]
-> Bool
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
(a -> String)
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, String)
interactivePrintResult (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
bs (ReadyForConstructionPL -> String)
-> (Result2 ReadyForConstructionPL Double Double
    -> ReadyForConstructionPL)
-> Result2 ReadyForConstructionPL Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
wwss Bool
syllables Int
syllablesVs else Bool
-> String
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, String)
print1el Bool
jstL0 String
choice [Result2 ReadyForConstructionPL Double Double]
wwss
   else do
    let !subs :: [String]
subs = String -> String -> [String]
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
js String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
vs) String
bs
    if [EncodedCnstrs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EncodedCnstrs]
argCs then let !perms :: [Array Int Int]
perms 
                              | PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
R.P Int
2 = Int -> [Array Int Int]
genPairwisePermutationsLN Int
l
                              | PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
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
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then (([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
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 [String]
subs ([Int]
intervalNmbrs, String
arg0, Int
numberI, String
choice)
          if Bool
recursiveMode then PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then (([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
bs (ReadyForConstructionPL -> String)
-> (Result2 ReadyForConstructionPL Double Double
    -> ReadyForConstructionPL)
-> Result2 ReadyForConstructionPL Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
temp [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
          else if Bool
interactive then (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double]
-> Bool
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
(a -> String)
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, String)
interactivePrintResult (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
bs (ReadyForConstructionPL -> String)
-> (Result2 ReadyForConstructionPL Double Double
    -> ReadyForConstructionPL)
-> Result2 ReadyForConstructionPL Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
temp Bool
syllables Int
syllablesVs else Bool
-> String
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, String)
print1el Bool
jstL0 String
choice [Result2 ReadyForConstructionPL Double Double]
temp
    else do
     String
correct <- String -> IO String
printWarning String
bs
     if String
correct String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"n" then String -> IO ()
putStrLn (Int -> String
messageInfo Int
1) IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
"",String
"") -- for the multiple variations mode (with curly brackets and slash in the text) the program does not stop here, but the variation is made empty and is proposed further as a variant.
     else let !perms :: [Array Int Int]
perms = [EncodedCnstrs] -> [Array Int Int] -> [Array Int Int]
forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
[EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints [EncodedCnstrs]
argCs ([Array Int Int] -> [Array Int Int])
-> (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
R.P Int
2 then Int -> [Array Int Int]
genPairwisePermutationsLN else if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
R.P Int
0 then Int -> [Array Int Int]
genPermutationsL else Int -> [Array Int Int]
genElementaryPermutationsLN1) (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall a b. (a -> b) -> a -> b
$ Int
l in do
          [Result2 ReadyForConstructionPL Double Double]
temp <- GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs  (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then (([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
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 [String]
subs ([Int]
intervalNmbrs, String
arg0, Int
numberI, String
choice)
          if Bool
recursiveMode then PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then (([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
bs (ReadyForConstructionPL -> String)
-> (Result2 ReadyForConstructionPL Double Double
    -> ReadyForConstructionPL)
-> Result2 ReadyForConstructionPL Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
temp [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
          else if Bool
interactive then (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double]
-> Bool
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
(a -> String)
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, String)
interactivePrintResult (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
bs (ReadyForConstructionPL -> String)
-> (Result2 ReadyForConstructionPL Double Double
    -> ReadyForConstructionPL)
-> Result2 ReadyForConstructionPL Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
temp Bool
syllables Int
syllablesVs else Bool
-> String
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, String)
print1el Bool
jstL0 String
choice [Result2 ReadyForConstructionPL Double Double]
temp
  else do
   let !choices :: [String]
choices = ((String, [String]) -> String) -> [(String, [String])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> String
forall a b. (a, b) -> a
fst [(String, [String])]
argMss
       !numericArgss :: Concatenations
numericArgss = ((String, [String]) -> [String])
-> [(String, [String])] -> Concatenations
forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> [String]
forall a b. (a, b) -> b
snd [(String, [String])]
argMss
       !arg0s :: [String]
arg0s = ([String] -> String) -> Concatenations -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1) Concatenations
numericArgss
       !numberIs :: [Int]
numberIs = ([String] -> Int) -> Concatenations -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\[String]
ts -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
ts)::Maybe Int)) Concatenations
numericArgss
       !intervalNmbrss :: [[Int]]
intervalNmbrss = ([String] -> [Int]) -> Concatenations -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (\[String]
us -> let !numberI :: Int
numberI = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
us)::Maybe Int) in
         (\[Int]
zs -> if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
zs then [Int
numberI] else [Int] -> [Int]
forall a. Eq a => [a] -> [a]
L.nub [Int]
zs) ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
numberI) ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\String
t -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
numberI (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
t::Maybe Int)) ([String] -> [Int]) -> ([String] -> [String]) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> [Int]) -> [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ [String]
us) (Concatenations -> [[Int]]) -> Concatenations -> [[Int]]
forall a b. (a -> b) -> a -> b
$ Concatenations
numericArgss
       !argsZipped :: [([Int], String, Int, String)]
argsZipped = [[Int]]
-> [String] -> [Int] -> [String] -> [([Int], String, Int, String)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
L.zip4 [[Int]]
intervalNmbrss [String]
arg0s [Int]
numberIs [String]
choices
       !bs :: String
bs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> Concatenations
-> Concatenations
-> String
-> String
-> [String]
prepareTuneTextMN (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
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 String
ws (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args
       !xs :: ReadyForConstructionPL
xs = String -> ReadyForConstructionPL
StrG String
bs
       !l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
bs
       !argCs :: [EncodedCnstrs]
argCs = [Maybe EncodedCnstrs] -> [EncodedCnstrs]
forall a. [Maybe a] -> [a]
catMaybes ((String -> Maybe EncodedCnstrs)
-> [String] -> [Maybe EncodedCnstrs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> Maybe EncodedCnstrs
readMaybeECG (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([String] -> [Maybe EncodedCnstrs])
-> ([String] -> [String]) -> [String] -> [Maybe EncodedCnstrs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool -> String
showB Int
l Bool
lstW2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+a") ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-a") ([String] -> [Maybe EncodedCnstrs])
-> [String] -> [Maybe EncodedCnstrs]
forall a b. (a -> b) -> a -> b
$ [String]
args0)
   ([[FlowSoundG]]
syllDs,[[[[Int8]]] -> [[Double]]]
syllableDs,ReadyForConstructionPL
readys) <- do if Bool
syllables then GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Int
-> Bool
-> String
-> IO
     ([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
      ReadyForConstructionPL)
weightsString3NIO  GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Int
syllablesVs ((Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Bool -> Bool
forall a. a -> a
id ((String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a')) [String]
choices)) String
bs else ([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
 ReadyForConstructionPL)
-> IO
     ([[FlowSoundG]], [[[[Int8]]] -> [[Double]]],
      ReadyForConstructionPL)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],[[[Int8]]] -> ReadyForConstructionPL
FSLG [])
   if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then let !frep20 :: FuncRep2 ReadyForConstructionPL Double Double
frep20 = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h Coeffs2
coeffs  (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') (String -> Bool) -> ([String] -> String) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
choices then (([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
qs) ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
choices) String
bs in
    let !wwss :: [Result2 ReadyForConstructionPL Double Double]
wwss = (Result2 ReadyForConstructionPL Double Double
-> [Result2 ReadyForConstructionPL Double Double]
-> [Result2 ReadyForConstructionPL Double Double]
forall a. a -> [a] -> [a]
:[]) (Result2 ReadyForConstructionPL Double Double
 -> [Result2 ReadyForConstructionPL Double Double])
-> (ReadyForConstructionPL
    -> Result2 ReadyForConstructionPL Double Double)
-> ReadyForConstructionPL
-> [Result2 ReadyForConstructionPL Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncRep2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
-> Result2 ReadyForConstructionPL Double Double
forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionPL Double Double
frep20 (ReadyForConstructionPL
 -> [Result2 ReadyForConstructionPL Double Double])
-> ReadyForConstructionPL
-> [Result2 ReadyForConstructionPL Double Double]
forall a b. (a -> b) -> a -> b
$ ReadyForConstructionPL
xs in
       if Bool
recursiveMode then PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs (if Bool
syllables then (([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs else [MappingFunctionPL]
sDs) Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
bs (ReadyForConstructionPL -> String)
-> (Result2 ReadyForConstructionPL Double Double
    -> ReadyForConstructionPL)
-> Result2 ReadyForConstructionPL Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
wwss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
       else if Bool
interactive then (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double]
-> Bool
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
(a -> String)
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, String)
interactivePrintResult (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs String
bs (ReadyForConstructionPL -> String)
-> (Result2 ReadyForConstructionPL Double Double
    -> ReadyForConstructionPL)
-> Result2 ReadyForConstructionPL Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
wwss Bool
syllables Int
syllablesVs
            else Bool
-> String
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, String)
print1el Bool
jstL0 ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
choices) [Result2 ReadyForConstructionPL Double Double]
wwss
   else do
    let !subs :: [String]
subs = String -> String -> [String]
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
js String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
vs) String
bs
    if [EncodedCnstrs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EncodedCnstrs]
argCs then let !perms :: [Array Int Int]
perms
                             | PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
R.P Int
2 = Int -> [Array Int Int]
genPairwisePermutationsLN Int
l
                             | PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
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
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [([Int], String, Int, String)]
-> [Array Int Int]
-> [String]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
generalProcMMs PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs ((([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs) Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [([Int], String, Int, String)]
argsZipped [Array Int Int]
perms [String]
subs [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
    else do
     String
correct <- String -> IO String
printWarning String
bs
     if String
correct String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"n" then String -> IO ()
putStrLn (Int -> String
messageInfo Int
1) IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
"",String
"") -- for the multiple variations mode (with curly brackets and slash in the text) the program does not stop here, but the variation is made empty and is proposed further as a variant.
     else let !perms :: [Array Int Int]
perms = [EncodedCnstrs] -> [Array Int Int] -> [Array Int Int]
forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
[EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints [EncodedCnstrs]
argCs ([Array Int Int] -> [Array Int Int])
-> (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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}) (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall a b. (a -> b) -> a -> b
$ Int
l in
            PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [([Int], String, Int, String)]
-> [Array Int Int]
-> [String]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
generalProcMMs PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs ((([[[Int8]]] -> [[Double]]) -> MappingFunctionPL)
-> [[[[Int8]]] -> [[Double]]] -> [MappingFunctionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> [[Double]]) -> MappingFunctionPL
SaaW [[[[Int8]]] -> [[Double]]]
syllableDs) Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [([Int], String, Int, String)]
argsZipped [Array Int Int]
perms [String]
subs [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose

-- | Function provides message information.
messageInfo :: Int -> String
messageInfo :: Int -> String
messageInfo Int
n
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String
"You stopped the program, please, if needed, run it again with better arguments. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = String
"Please, specify the variant which you would like to become the resulting string by its number. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = String
"Please, check whether the line below corresponds and is consistent with the constraints you have specified between the +a and -a options. Check also whether you have specified the \"+b\" or \"+bl\" option(s). If it is inconsistent then enter further \"n\", press Enter and then run the program again with better arguments. " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"If the line is consistent with your input between +a and -a then just press Enter to proceed further. " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = String
"No data has been specified to control the computation process. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = String
"(/ You have specified properties / property and the range(s) so that for the words and their concatenations there are no variants available. Try to change the call parameters /)"
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = String
"If you would like to run the program (call the function) recursively with changes for the words or letter connections then, please, enter here the encoded string of the interpreter. If you would NOT like to use it recursively, then just press Enter."
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = String
"Please, input the text line for analysis. "
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = String
"Please, input the number of words or their concatenations that the program takes as one line for analysis. "
 | Bool
otherwise = String
"You have specified just one variant of the properties. "

-- |
interactivePrintResult 
 :: (a -> String) 
 -> [a] 
 -> Bool
 -> Int
 -> IO (ReadyForConstructionPL,String)
interactivePrintResult :: (a -> String)
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, String)
interactivePrintResult a -> String
f [a]
xss Bool
syllables Int
syllablesVs
  | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xss = (String -> IO ()
putStrLn (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
messageInfo (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
5) IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
"",String
"")
  | Bool
otherwise = do
     let !datas :: [String]
datas = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
idx,String
str) -> Int -> String
forall a. Show a => a -> String
show Int
idx String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` (Char
'\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String
str)) ([(Int, String)] -> [String])
-> ([a] -> [(Int, String)]) -> [a] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(Int, String)]
forall a. [[a]] -> [(Int, [a])]
trans232 ([String] -> [(Int, String)])
-> ([a] -> [String]) -> [a] -> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f ([a] -> [String]) -> [a] -> [String]
forall a b. (a -> b) -> a -> b
$ [a]
xss
     if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
datas then (String -> IO ()
putStrLn (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
messageInfo (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
5) IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
"",String
"")
     else do
      (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
datas
      String -> IO ()
putStrLn String
""
      String -> IO ()
putStrLn (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
messageInfo (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
2
      String
number <- IO String
getLine
      let !lineRes :: String
lineRes = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
number String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\t")String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
datas
          !ts :: String
ts = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
lineRes
      String -> IO ()
putStrLn String
ts IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
ts,String
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
 -> IO (ReadyForConstructionPL,String)
interactivePrintResultRecursive :: PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX a -> String
f [a]
xss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
  | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xss = (String -> IO ()
putStrLn (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
messageInfo (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
5) IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
"",String
"")
  | Bool
otherwise = do
     let !datas :: [String]
datas = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
idx,String
str) -> Int -> String
forall a. Show a => a -> String
show Int
idx String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` (Char
'\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String
str)) ([(Int, String)] -> [String])
-> ([a] -> [(Int, String)]) -> [a] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(Int, String)]
forall a. [[a]] -> [(Int, [a])]
trans232 ([String] -> [(Int, String)])
-> ([a] -> [String]) -> [a] -> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f ([a] -> [String]) -> [a] -> [String]
forall a b. (a -> b) -> a -> b
$ [a]
xss
     (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
datas
     String -> IO ()
putStrLn String
""
     String -> IO ()
putStrLn (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
messageInfo (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
2
     String
number <- IO String
getLine
     let !lineRes :: String
lineRes = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
number String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\t")String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
datas
         !ts :: String
ts = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
lineRes
     String -> IO ()
putStrLn (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
messageInfo (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
6
     String
stringInterpreted <- IO String
getLine
     if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
stringInterpreted then String -> IO ()
putStrLn String
ts IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
ts,String
ts)
     else do
       let !firstArgs :: [String]
firstArgs = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLetter) [String]
args
       String
strIntrpr <- String -> String -> IO String
convStringInterpreterIO String
stringInterpreted String
ts
       [String]
wordsNN <-
         if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
R.P Int
0 then do
           String -> IO ()
putStrLn (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
messageInfo (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
8
           String
mStr <- IO String
getLine
           let m :: Int
m = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
10 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
mStr::Maybe Int) in [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> (String -> [String]) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
m ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
strIntrpr
         else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> (String -> [String]) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
7 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
strIntrpr
       PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
generalProc2 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX ([String]
firstArgs [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
wordsNN) Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose

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

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

print2 :: a -> [Result2 ReadyForConstructionPL a a] -> IO ()
print2 a
verbose = String -> IO ()
putStrLn (String -> IO ())
-> ([Result2 ReadyForConstructionPL a a] -> String)
-> [Result2 ReadyForConstructionPL a a]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Result2 ReadyForConstructionPL a a] -> String
forall a a a.
(Show a, Show a, Num a, Ord a, Ord a, Eq a) =>
a -> [Result2 ReadyForConstructionPL a a] -> String
show2 a
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 +.
 -> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [String]
subs ([Int]
intervalNmbrs, String
arg0, Int
numberI, String
choice) = do
  let bs :: String
bs = [String] -> String
unwords [String]
subs
  if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
numberI Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
   then let !frep2 :: FuncRep2 ReadyForConstructionPL Double Double
frep2 =  GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w' Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x') String
choice then Coeffs2
coeffsWX else Coeffs2
coeffs) (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [MappingFunctionPL]
sDs else [MappingFunctionPL]
qs) String
choice String
bs
                in [Result2 ReadyForConstructionPL Double Double]
-> IO [Result2 ReadyForConstructionPL Double Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Result2 ReadyForConstructionPL Double Double]
 -> IO [Result2 ReadyForConstructionPL Double Double])
-> ([String] -> [Result2 ReadyForConstructionPL Double Double])
-> [String]
-> IO [Result2 ReadyForConstructionPL Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Result2 ReadyForConstructionPL Double Double],
 [Result2 ReadyForConstructionPL Double Double])
-> [Result2 ReadyForConstructionPL Double Double]
forall a b. (a, b) -> a
fst (([Result2 ReadyForConstructionPL Double Double],
  [Result2 ReadyForConstructionPL Double Double])
 -> [Result2 ReadyForConstructionPL Double Double])
-> ([String]
    -> ([Result2 ReadyForConstructionPL Double Double],
        [Result2 ReadyForConstructionPL Double Double]))
-> [String]
-> [Result2 ReadyForConstructionPL Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'G') String
choice then String
-> [Result2 ReadyForConstructionPL Double Double]
-> ([Result2 ReadyForConstructionPL Double Double],
    [Result2 ReadyForConstructionPL Double Double])
forall (t2 :: * -> *) a b.
(InsertLeft t2 (Result2 a b Double),
 Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
String
-> t2 (Result2 a b Double)
-> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 String
arg0 else Int
-> [Result2 ReadyForConstructionPL Double Double]
-> ([Result2 ReadyForConstructionPL Double Double],
    [Result2 ReadyForConstructionPL Double Double])
forall (t2 :: * -> *) a b c d.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c, Integral d) =>
d -> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR_2 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
arg0::Maybe Int))) ([Result2 ReadyForConstructionPL Double Double]
 -> ([Result2 ReadyForConstructionPL Double Double],
     [Result2 ReadyForConstructionPL Double Double]))
-> ([String] -> [Result2 ReadyForConstructionPL Double Double])
-> [String]
-> ([Result2 ReadyForConstructionPL Double Double],
    [Result2 ReadyForConstructionPL Double Double])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL
 -> Result2 ReadyForConstructionPL Double Double)
-> [ReadyForConstructionPL]
-> [Result2 ReadyForConstructionPL Double Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
-> Result2 ReadyForConstructionPL Double Double
forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionPL Double Double
frep2) ([ReadyForConstructionPL]
 -> [Result2 ReadyForConstructionPL Double Double])
-> ([String] -> [ReadyForConstructionPL])
-> [String]
-> [Result2 ReadyForConstructionPL Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ReadyForConstructionPL)
-> [String] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadyForConstructionPL
StrG ([String] -> [ReadyForConstructionPL])
-> ([String] -> [String]) -> [String] -> [ReadyForConstructionPL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> (String -> String)
-> ([String] -> [String])
-> (String -> String)
-> [Array Int Int]
-> [String]
-> [String]
forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNBL Char
' ' String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id String -> String
forall a. a -> a
id [Array Int Int]
perms ([String] -> IO [Result2 ReadyForConstructionPL Double Double])
-> [String] -> IO [Result2 ReadyForConstructionPL Double Double]
forall a b. (a -> b) -> a -> b
$ [String]
subs
   else do
    let !variants1 :: [String]
variants1 = Char
-> (String -> String)
-> ([String] -> [String])
-> (String -> String)
-> [Array Int Int]
-> [String]
-> [String]
forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNBL Char
' ' String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id String -> String
forall a. a -> a
id [Array Int Int]
perms [String]
subs
        !frep20 :: FuncRep2 ReadyForConstructionPL Double Double
frep20 = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w') String
choice then Coeffs2
coeffsWX else Coeffs2
coeffs) (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [MappingFunctionPL]
sDs else [MappingFunctionPL]
qs) String
choice String
bs
        (!Double
minE,!Double
maxE) = [Double] -> (Double, Double)
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, a)
minMax11C ([Double] -> (Double, Double))
-> ([ReadyForConstructionPL] -> [Double])
-> [ReadyForConstructionPL]
-> (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL -> Double)
-> [ReadyForConstructionPL] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL -> Double
forall a b c. FuncRep2 a b c -> a -> b
toPropertiesF'2 FuncRep2 ReadyForConstructionPL Double Double
frep20) ([ReadyForConstructionPL] -> (Double, Double))
-> [ReadyForConstructionPL] -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ (String -> ReadyForConstructionPL)
-> [String] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadyForConstructionPL
StrG [String]
variants1
        !frep2 :: FuncRep2 ReadyForConstructionPL Double Double
frep2 = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs (Double -> Double -> Int -> [Int] -> Double -> Double
forall b c.
(RealFrac b, Integral c) =>
b -> b -> c -> [c] -> b -> b
unsafeSwapVecIWithMaxI Double
minE Double
maxE Int
numberI [Int]
intervalNmbrs) Double -> String -> MappingFunctionPL
h 
           (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w') String
choice then Coeffs2
coeffsWX else Coeffs2
coeffs) (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice then [MappingFunctionPL]
sDs else [MappingFunctionPL]
qs) String
choice String
bs 
    [Result2 ReadyForConstructionPL Double Double]
-> IO [Result2 ReadyForConstructionPL Double Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Result2 ReadyForConstructionPL Double Double]
 -> IO [Result2 ReadyForConstructionPL Double Double])
-> ([ReadyForConstructionPL]
    -> [Result2 ReadyForConstructionPL Double Double])
-> [ReadyForConstructionPL]
-> IO [Result2 ReadyForConstructionPL Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Result2 ReadyForConstructionPL Double Double],
 [Result2 ReadyForConstructionPL Double Double])
-> [Result2 ReadyForConstructionPL Double Double]
forall a b. (a, b) -> a
fst (([Result2 ReadyForConstructionPL Double Double],
  [Result2 ReadyForConstructionPL Double Double])
 -> [Result2 ReadyForConstructionPL Double Double])
-> ([ReadyForConstructionPL]
    -> ([Result2 ReadyForConstructionPL Double Double],
        [Result2 ReadyForConstructionPL Double Double]))
-> [ReadyForConstructionPL]
-> [Result2 ReadyForConstructionPL Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'G') String
choice then String
-> [Result2 ReadyForConstructionPL Double Double]
-> ([Result2 ReadyForConstructionPL Double Double],
    [Result2 ReadyForConstructionPL Double Double])
forall (t2 :: * -> *) a b.
(InsertLeft t2 (Result2 a b Double),
 Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
String
-> t2 (Result2 a b Double)
-> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 String
arg0 else Int
-> [Result2 ReadyForConstructionPL Double Double]
-> ([Result2 ReadyForConstructionPL Double Double],
    [Result2 ReadyForConstructionPL Double Double])
forall (t2 :: * -> *) a b c d.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c, Integral d) =>
d -> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR_2 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
arg0::Maybe Int))) ([Result2 ReadyForConstructionPL Double Double]
 -> ([Result2 ReadyForConstructionPL Double Double],
     [Result2 ReadyForConstructionPL Double Double]))
-> ([ReadyForConstructionPL]
    -> [Result2 ReadyForConstructionPL Double Double])
-> [ReadyForConstructionPL]
-> ([Result2 ReadyForConstructionPL Double Double],
    [Result2 ReadyForConstructionPL Double Double])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL
 -> Result2 ReadyForConstructionPL Double Double)
-> [ReadyForConstructionPL]
-> [Result2 ReadyForConstructionPL Double Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
-> Result2 ReadyForConstructionPL Double Double
forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionPL Double Double
frep2) ([ReadyForConstructionPL]
 -> IO [Result2 ReadyForConstructionPL Double Double])
-> [ReadyForConstructionPL]
-> IO [Result2 ReadyForConstructionPL Double Double]
forall a b. (a -> b) -> a -> b
$ (String -> ReadyForConstructionPL)
-> [String] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadyForConstructionPL
StrG [String]
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
 -> IO (ReadyForConstructionPL, String)
generalProcMMs :: PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> [([Int], String, Int, String)]
-> [Array Int Int]
-> [String]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
generalProcMMs PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactiveMM Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX [([Int], String, Int, String)]
rs [Array Int Int]
perms [String]
subs [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose=
 case [([Int], String, Int, String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Int], String, Int, String)]
rs of
  Int
0 -> String -> IO ()
putStrLn (Int -> String
messageInfo Int
4) IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
"",String
"")
  Int
1 -> String -> IO ()
putStrLn (Int -> String
messageInfo Int
5) IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
        [Result2 ReadyForConstructionPL Double Double]
temp <- GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [String]
subs ([([Int], String, Int, String)] -> ([Int], String, Int, String)
forall a. [a] -> a
head [([Int], String, Int, String)]
rs)
        if Int
verbose Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1..Int
3] then Int -> [Result2 ReadyForConstructionPL Double Double] -> IO ()
forall a a a.
(Show a, Show a, Num a, Ord a, Ord a, Eq a) =>
a -> [Result2 ReadyForConstructionPL a a] -> IO ()
print2 Int
verbose [Result2 ReadyForConstructionPL Double Double]
temp IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"" else String -> IO ()
putStr String
""
        PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
finalProc PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactiveMM Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs ([String] -> String
unwords [String]
args) (ReadyForConstructionPL -> String)
-> (Result2 ReadyForConstructionPL Double Double
    -> ReadyForConstructionPL)
-> Result2 ReadyForConstructionPL Double Double
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) [Result2 ReadyForConstructionPL Double Double]
temp [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
  Int
_ -> do
         [[Result2 ReadyForConstructionPL Double Double]]
genVariants <- (([Int], String, Int, String)
 -> IO [Result2 ReadyForConstructionPL Double Double])
-> [([Int], String, Int, String)]
-> IO [[Result2 ReadyForConstructionPL Double Double]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\([Int], String, Int, String)
k-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Coeffs2
-> Coeffs2
-> [Array Int Int]
-> [String]
-> ([Int], String, Int, String)
-> IO [Result2 ReadyForConstructionPL Double Double]
generalProcMs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Coeffs2
coeffs Coeffs2
coeffsWX [Array Int Int]
perms [String]
subs ([Int], String, Int, String)
k) [([Int], String, Int, String)]
rs
         if Int
verbose Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1..Int
3] then ([Result2 ReadyForConstructionPL Double Double] -> IO ())
-> [[Result2 ReadyForConstructionPL Double Double]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Result2 ReadyForConstructionPL Double Double]
t -> Int -> [Result2 ReadyForConstructionPL Double Double] -> IO ()
forall a a a.
(Show a, Show a, Num a, Ord a, Ord a, Eq a) =>
a -> [Result2 ReadyForConstructionPL a a] -> IO ()
print2 Int
verbose [Result2 ReadyForConstructionPL Double Double]
t IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"") [[Result2 ReadyForConstructionPL Double Double]]
genVariants else String -> IO ()
putStr String
""
         PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (ReadyForConstructionPL -> String)
-> [ReadyForConstructionPL]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
finalProc PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactiveMM Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs ([String] -> String
unwords [String]
args)) (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[ReadyForConstructionPL]]
-> [ReadyForConstructionPL]
foldlI GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs ([String] -> String
unwords [String]
args)([[ReadyForConstructionPL]] -> [ReadyForConstructionPL])
-> ([[Result2 ReadyForConstructionPL Double Double]]
    -> [[ReadyForConstructionPL]])
-> [[Result2 ReadyForConstructionPL Double Double]]
-> [ReadyForConstructionPL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Result2 ReadyForConstructionPL Double Double]
 -> [ReadyForConstructionPL])
-> [[Result2 ReadyForConstructionPL Double Double]]
-> [[ReadyForConstructionPL]]
forall a b. (a -> b) -> [a] -> [b]
map ((Result2 ReadyForConstructionPL Double Double
 -> ReadyForConstructionPL)
-> [Result2 ReadyForConstructionPL Double Double]
-> [ReadyForConstructionPL]
forall a b. (a -> b) -> [a] -> [b]
map Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2) ([[Result2 ReadyForConstructionPL Double Double]]
 -> [ReadyForConstructionPL])
-> [[Result2 ReadyForConstructionPL Double Double]]
-> [ReadyForConstructionPL]
forall a b. (a -> b) -> a -> b
$ [[Result2 ReadyForConstructionPL Double Double]]
genVariants) [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose

-- |
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
 -> IO (ReadyForConstructionPL,String)
finalProc :: PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
finalProc  PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX a -> String
f [a]
xss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | Bool
recursiveMode = PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
forall a.
PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> Bool
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> Coeffs2
-> (a -> String)
-> [a]
-> [String]
-> Bool
-> Bool
-> Int
-> Int
-> IO (ReadyForConstructionPL, String)
interactivePrintResultRecursive PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [MappingFunctionPL]
sDs Concatenations
ysss Concatenations
zzzsss String
ws Bool
recursiveMode Bool
interactive Bool
jstL0 [String]
args0 Coeffs2
coeffs Coeffs2
coeffsWX a -> String
f [a]
xss [String]
args Bool
lstW2 Bool
syllables Int
syllablesVs Int
verbose
 | Bool
otherwise = if Bool
interactive then (a -> String)
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, String)
forall a.
(a -> String)
-> [a] -> Bool -> Int -> IO (ReadyForConstructionPL, String)
interactivePrintResult a -> String
f [a]
xss Bool
syllables Int
syllablesVs else String -> IO ()
putStrLn String
ts IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
ts,String
ts)
  where ts :: String
ts = (a -> String) -> [a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
t -> a -> String
f a
t String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding) [a]
xss

-- |
print1el :: Bool -> String -> [Result2 ReadyForConstructionPL Double Double] -> IO (ReadyForConstructionPL,String)
print1el :: Bool
-> String
-> [Result2 ReadyForConstructionPL Double Double]
-> IO (ReadyForConstructionPL, String)
print1el Bool
jstlines String
choice [Result2 ReadyForConstructionPL Double Double]
y
 | Bool
jstlines Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True = String -> IO ()
putStrLn String
us IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
us,String
us)
 | Bool
otherwise = String -> IO ()
putStrLn String
zs IO ()
-> IO (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadyForConstructionPL, String)
-> IO (ReadyForConstructionPL, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadyForConstructionPL
StrG String
zs,String
zs)
       where !ch :: Maybe Int
ch = String -> Maybe Int
precChoice String
choice
             !us :: String
us = (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Result2 ReadyForConstructionPL Double Double
ys -> ReadyForConstructionPL -> String
showR (Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2 Result2 ReadyForConstructionPL Double Double
ys) String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding) [Result2 ReadyForConstructionPL Double Double]
y
             !zs :: String
zs = (Result2 ReadyForConstructionPL Double Double -> String)
-> [Result2 ReadyForConstructionPL Double Double] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Result2 ReadyForConstructionPL Double Double
ys -> ReadyForConstructionPL -> String
showR (Result2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL
forall a b c. Result2 a b c -> a
line2 Result2 ReadyForConstructionPL Double Double
ys) String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
ch (Result2 ReadyForConstructionPL Double Double -> Double
forall a b c. Result2 a b c -> b
propertiesF2 Result2 ReadyForConstructionPL Double Double
ys) (String
newLineEnding String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
ch (Result2 ReadyForConstructionPL Double Double -> Double
forall a b c. Result2 a b c -> c
transPropertiesF2 Result2 ReadyForConstructionPL Double Double
ys) String
newLineEnding)) [Result2 ReadyForConstructionPL Double Double]
y