{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}

module Phladiprelio.General.Simple where

import GHC.Base
import GHC.Enum (fromEnum)
import GHC.Real (Integral,fromIntegral,(/),quot,rem,quotRem,round,gcd,(^))
import Text.Show (Show(..))
import Phladiprelio.General.PrepareText 
import Phladiprelio.General.Syllables 
import Phladiprelio.General.Base
import System.Environment (getArgs)
import GHC.Num (Num,(+),(-),(*),Integer)
import Text.Read (readMaybe)
import System.IO (putStrLn, FilePath,stdout,universalNewlineMode,hSetNewlineMode,getLine,appendFile,readFile,writeFile,putStr)
import Rhythmicity.MarkerSeqs hiding (id) 
import Data.List hiding (foldr)
import Data.Maybe (fromMaybe, mapMaybe, catMaybes,isNothing,fromJust) 
import Data.Tuple (fst)
import Data.Char (isDigit,isSpace)
import CLI.Arguments
import CLI.Arguments.Get
import CLI.Arguments.Parsing
import GHC.Int (Int8)
import Data.Ord (comparing)
import Phladiprelio.ConstraintsEncoded
import Phladiprelio.PermutationsArr
import Phladiprelio.StrictVG
import Numeric (showFFloat)
import Phladiprelio.Halfsplit
import System.Directory (doesFileExist,readable,writable,getPermissions,Permissions(..),doesFileExist,getCurrentDirectory)
import Data.ReversedScientific
import Control.Concurrent.Async (mapConcurrently)
import Data.MinMax1 (minMax11By) 
import Phladiprelio.Tests
import Phladiprelio.General.Datatype3
import Phladiprelio.General.Distance
import Phladiprelio.UniquenessPeriodsG
import Data.ChooseLine

generalF 
 :: Int -- ^ A power of 10. 10 in this power is then multiplied the value of distance if the next ['Double'] argument is not empty. The default one is 4. The proper values are in the range [2..6].
 -> Int -- ^ A 'length' of the next argument here.
 -> [Double] -- ^ A list of non-negative values normed by 1.0 (the greatest of which is 1.0) that the line options are compared with. If null, then the program works as for version 0.12.1.0 without this newly-introduced argument since the version 0.13.0.0. The length of it must be a least common multiplier of the (number of syllables plus number of \'_digits\' groups) to work correctly. Is not used when the next 'FilePath' and 'String' arguments are not null.
 -> Bool -- ^ If 'True' then adds \"<br>\" to line endings for double column output
 -> FilePath -- ^ A path to the file to save double columns output to. If empty then just prints to 'stdout'.
 -> String -- ^ If not null than instead of rhythmicity evaluation using hashes and and feets, there is computed a diversity property for the specified 'String' here using the 'selectSounds' function. For more information, see: 'https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types'
 -> (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#selectSounds. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
 -> (String, String)  -- ^ If the next element is not equal to -1, then the prepending and appending lines to be displayed. Used basically for working with the multiline textual input data.
 -> Int -- ^ The number of the line in the file to be read the lines from. If equal to -1 then neither reading from the file is done nor the first argument influences the processment results.
 -> 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
 -> SegmentRulesG
 -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> ([[[PRS]]] -> [[Double]])
 -> Int
 -> HashCorrections 
 -> (Int8,[Int8])
 -> Bool
 -> Int -- ^ The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12. 
 -> Bool 
 -> Int8
 -> (FilePath, Int)
 -> Bool -- ^ In the testing mode, whether to execute computations in concurrent mode (for speed up) or in single thread. If specified needs the executable to be compiled with -rtsopts and -threaded options and run with the command line +RTS -N -RTS options.
 -> String -- ^ An initial string to be analyzed.
 -> [String] 
 -> IO [String] 
generalF :: GQtyArgs
-> GQtyArgs
-> [Double]
-> Bool
-> String
-> String
-> (String -> String)
-> (String, String)
-> GQtyArgs
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> GQtyArgs
-> HashCorrections
-> (Int8, [Int8])
-> Bool
-> GQtyArgs
-> Bool
-> Int8
-> (String, GQtyArgs)
-> Bool
-> String
-> [String]
-> IO [String]
generalF GQtyArgs
power10 GQtyArgs
ldc [Double]
compards Bool
html String
dcfile String
selStr String -> String
selFun (String
prestr,String
poststr) GQtyArgs
lineNmb GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [[[PRS]]] -> [[Double]]
h GQtyArgs
numTest HashCorrections
hc (Int8
grps,[Int8]
mxms) Bool
descending GQtyArgs
hashStep Bool
emptyline Int8
splitting (String
fs, GQtyArgs
code) Bool
concurrently String
initstr [String]
universalSet 
 | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
universalSet = do
     let strOutput :: [String]
strOutput = [String
"You have specified the data and constraints on it that lead to no further possible options.", String
"Please, specify another data and constraints."] 
     String -> IO ()
putStrLn (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String]
strOutput
     [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
strOutput
 | [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
universalSet GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
1 = do
     String -> IO ()
putStrLn (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String]
universalSet
     [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
universalSet
 | Bool
otherwise = do
   let syllN :: GQtyArgs
syllN = GWritingSystemPRPLX
-> CharPhoneticClassification
-> String
-> String
-> String
-> GQtyArgs
countSyll GWritingSystemPRPLX
wrs CharPhoneticClassification
arr String
us String
vs String
initstr
--       universalSet = map unwords . permutations $ rss
       f :: GQtyArgs -> [Double] -> Int8 -> [Int8] -> String -> Integer
f GQtyArgs
ldc [Double]
compards Int8
grps [Int8]
mxms 
          | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
selStr = (if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
compards then ([Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer)
-> ([Double] -> [Integer]) -> [Double] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs
-> HashCorrections -> Int8 -> [Int8] -> [Double] -> [Integer]
forall a.
Ord a =>
GQtyArgs -> HashCorrections -> Int8 -> [Int8] -> [a] -> [Integer]
countHashes2G GQtyArgs
hashStep HashCorrections
hc Int8
grps [Int8]
mxms) else (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> ([Double] -> Double) -> [Double] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
10Double -> GQtyArgs -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^GQtyArgs
power10) (Double -> Double) -> ([Double] -> Double) -> [Double] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [Double] -> [Double] -> Double
forall a.
(Real a, Floating a, Fractional a) =>
GQtyArgs -> [a] -> [a] -> a
distanceSqrG2 GQtyArgs
ldc [Double]
compards)) ([Double] -> Integer) -> (String -> [Double]) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool)
-> Double -> (String -> [Double]) -> String -> [Double]
read3 (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) Double
1.0 ([[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> (String -> [[Double]]) -> String -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PRS]]] -> [[Double]]
h ([[[PRS]]] -> [[Double]])
-> (String -> [[[PRS]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs)
          | Bool
otherwise = Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Integer) -> (String -> Int16) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> Int16
forall (t1 :: * -> *) (t2 :: * -> *) (t3 :: * -> *) a.
(Foldable t1, Foldable t2, Foldable t3, Ord a) =>
t3 a -> t1 a -> t2 a -> Int16
diverse2GGL ((String -> String) -> String -> String
selectSounds String -> String
selFun String
selStr) (String
us String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
vs) (String -> Int16) -> (String -> String) -> String -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> String)
-> [PhoneticsRepresentationPLX] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PhoneticsRepresentationPLX -> String
string1 ([PhoneticsRepresentationPLX] -> String)
-> (String -> [PhoneticsRepresentationPLX]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs (String -> [PhoneticsRepresentationPLX])
-> (String -> String) -> String -> [PhoneticsRepresentationPLX]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Bool -> Bool
not (Char -> Bool
isDigit Char
c) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')
   Handle -> NewlineMode -> IO ()
hSetNewlineMode Handle
stdout NewlineMode
universalNewlineMode
   if GQtyArgs
numTest GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
>= GQtyArgs
0 Bool -> Bool -> Bool
&& GQtyArgs
numTest GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
<= GQtyArgs
179 Bool -> Bool -> Bool
&& GQtyArgs
numTest GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
/= GQtyArgs
1 Bool -> Bool -> Bool
&& [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
compards then Bool
-> GQtyArgs
-> (GQtyArgs -> [Double] -> Int8 -> [Int8] -> String -> Integer)
-> GQtyArgs
-> GQtyArgs
-> [String]
-> IO [String]
forall a1 p a2.
(Show a1, Integral a1) =>
Bool
-> GQtyArgs
-> (p -> [a2] -> Int8 -> [Int8] -> String -> a1)
-> p
-> GQtyArgs
-> [String]
-> IO [String]
testsOutput Bool
concurrently GQtyArgs
syllN GQtyArgs -> [Double] -> Int8 -> [Int8] -> String -> Integer
f GQtyArgs
ldc GQtyArgs
numTest [String]
universalSet 
   else let sRepresent :: [PhladiprelioGen]
sRepresent = (GQtyArgs -> (Integer, String) -> PhladiprelioGen)
-> [GQtyArgs] -> [(Integer, String)] -> [PhladiprelioGen]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\GQtyArgs
k (Integer
x, String
ys) -> GQtyArgs -> Integer -> String -> PhladiprelioGen
S GQtyArgs
k Integer
x String
ys) [GQtyArgs
1..] ([(Integer, String)] -> [PhladiprelioGen])
-> ([String] -> [(Integer, String)])
-> [String]
-> [PhladiprelioGen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
             (let h1 :: (Integer, b) -> (Integer, b)
h1 = if Bool
descending then (\(Integer
u,b
w) -> ((-Integer
1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
u,b
w)) else (Integer, b) -> (Integer, b)
forall a. a -> a
id in ((Integer, String) -> (Integer, String))
-> [(Integer, String)] -> [(Integer, String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Integer, String) -> (Integer, String)
forall {b}. (Integer, b) -> (Integer, b)
h1) ([(Integer, String)] -> [(Integer, String)])
-> ([String] -> [(Integer, String)])
-> [String]
-> [(Integer, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Integer, String)) -> [String] -> [(Integer, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
xss -> (GQtyArgs -> [Double] -> Int8 -> [Int8] -> String -> Integer
f GQtyArgs
ldc [Double]
compards Int8
grps [Int8]
mxms String
xss, String
xss)) ([String] -> [PhladiprelioGen]) -> [String] -> [PhladiprelioGen]
forall a b. (a -> b) -> a -> b
$ [String]
universalSet
            strOutput :: [String]
strOutput = (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String])
-> ([PhladiprelioGen] -> String) -> [PhladiprelioGen] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhladiprelioGen -> Integer)
-> String -> Int8 -> [PhladiprelioGen] -> String
forall a b.
(Show a, Eq b) =>
(a -> b) -> String -> Int8 -> [a] -> String
halfsplit1G (\(S GQtyArgs
_ Integer
y String
_) -> Integer
y) (if Bool
html then String
"<br>" else String
"") (Int8 -> Int8
forall {a}. Integral a => a -> a
jjj Int8
splitting) ([PhladiprelioGen] -> [String]) -> [PhladiprelioGen] -> [String]
forall a b. (a -> b) -> a -> b
$ [PhladiprelioGen]
sRepresent
            lns1 :: String
lns1 = [String] -> String
unlines [String]
strOutput
                          in do
                             String -> IO ()
putStrLn String
lns1
                             if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dcfile then String -> IO ()
putStr String
"" 
                             else do 
                                 String -> IO Bool
doesFileExist String
dcfile IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
exist -> if Bool
exist then do 
                                       String -> IO Permissions
getPermissions String
dcfile IO Permissions -> (Permissions -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Permissions
perms -> if Permissions -> Bool
writable Permissions
perms then String -> String -> IO ()
writeFile String
dcfile String
lns1 
                                                                           else String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Phladiprelio.General.IO.generalF: File " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
dcfile String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
" is not writable!" 
                                    else do 
                                       IO String
getCurrentDirectory IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
currdir -> do 
                                          String -> IO Permissions
getPermissions String
currdir IO Permissions -> (Permissions -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Permissions
perms -> if Permissions -> Bool
writable Permissions
perms then String -> String -> IO ()
writeFile String
dcfile String
lns1 
                                                                               else String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Phladiprelio.General.IO.generalF: Directory of the file " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
dcfile String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
" is not writable!"
                             let l1 :: GQtyArgs
l1 = [PhladiprelioGen] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [PhladiprelioGen]
sRepresent
                             if GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== -GQtyArgs
1 
                                 then if GQtyArgs
lineNmb GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== -GQtyArgs
1 then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
strOutput
                                      else do 
                                          String -> String -> GQtyArgs -> [String] -> IO ()
print23 String
prestr String
poststr GQtyArgs
1 [String
initstr]
                                          [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
strOutput
                                 else do 
                                       String -> String -> GQtyArgs -> [String] -> IO ()
print23 String
prestr String
poststr GQtyArgs
1 [String
initstr]
                                       GQtyArgs -> IO GQtyArgs
parseLineNumber GQtyArgs
l1 IO GQtyArgs -> (GQtyArgs -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GQtyArgs
num -> do
                                         Permissions
permiss <- String -> IO Permissions
getPermissions String
fs
                                         let writ :: Bool
writ = Permissions -> Bool
writable Permissions
permiss
                                             readab :: Bool
readab = Permissions -> Bool
readable Permissions
permiss
                                         if Bool
writ Bool -> Bool -> Bool
&& Bool
readab then ([[[PRS]]] -> [[Double]])
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [Double]
-> [PhladiprelioGen]
-> GQtyArgs
-> Int8
-> String
-> GQtyArgs
-> IO ()
forall a1.
(Eq a1, Num a1) =>
([[[PRS]]] -> [[Double]])
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [Double]
-> [PhladiprelioGen]
-> GQtyArgs
-> a1
-> String
-> GQtyArgs
-> IO ()
outputWithFile [[[PRS]]] -> [[Double]]
h GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs String
selStr [Double]
compards [PhladiprelioGen]
sRepresent GQtyArgs
code Int8
grps String
fs GQtyArgs
num
                                         else String -> IO ()
forall a. HasCallStack => String -> a
error String
"The specified file cannot be used for appending the text! Please, specify another file!"
                                         [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
     where jjj :: a -> a
jjj a
kk = let (a
q1,a
r1) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
kk (if a
kk a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then -a
10 else a
10) in a -> a -> Bool -> a
forall {a}. (Num a, Ord a) => a -> a -> Bool -> a
jjj' a
q1 a
r1 Bool
emptyline
           jjj' :: a -> a -> Bool -> a
jjj' a
q1 a
r1 Bool
emptyline
             | a
r1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (-a
1) Bool -> Bool -> Bool
|| a
r1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (-a
3) = -a
10a -> a -> a
forall a. Num a => a -> a -> a
*a
q1 a -> a -> a
forall a. Num a => a -> a -> a
+ (if Bool
emptyline then -a
5 else a
r1)
             | a
r1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 Bool -> Bool -> Bool
|| a
r1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
3 = a
10a -> a -> a
forall a. Num a => a -> a -> a
*a
q1 a -> a -> a
forall a. Num a => a -> a -> a
+ (if Bool
emptyline then a
5 else a
r1)
             | a
r1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = -a
10a -> a -> a
forall a. Num a => a -> a -> a
*a
q1 a -> a -> a
forall a. Num a => a -> a -> a
+ (if Bool
emptyline then -a
4 else a
r1)
             | Bool
otherwise = a
10a -> a -> a
forall a. Num a => a -> a -> a
*a
q1 a -> a -> a
forall a. Num a => a -> a -> a
+ (if Bool
emptyline then a
4 else a
r1)

data PhladiprelioGen = S Int Integer String deriving PhladiprelioGen -> PhladiprelioGen -> Bool
(PhladiprelioGen -> PhladiprelioGen -> Bool)
-> (PhladiprelioGen -> PhladiprelioGen -> Bool)
-> Eq PhladiprelioGen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhladiprelioGen -> PhladiprelioGen -> Bool
== :: PhladiprelioGen -> PhladiprelioGen -> Bool
$c/= :: PhladiprelioGen -> PhladiprelioGen -> Bool
/= :: PhladiprelioGen -> PhladiprelioGen -> Bool
Eq

instance Show PhladiprelioGen where
  show :: PhladiprelioGen -> String
show (S GQtyArgs
i Integer
j String
xs) = GQtyArgs -> Integer -> String
showBignum GQtyArgs
7 Integer
j String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
" " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
xs String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"  " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` GQtyArgs -> GQtyArgs -> String
forall a. Show a => GQtyArgs -> a -> String
showWithSpaces GQtyArgs
4 GQtyArgs
i

countSyll 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> CharPhoneticClassification 
  ->  String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> Int
countSyll :: GWritingSystemPRPLX
-> CharPhoneticClassification
-> String
-> String
-> String
-> GQtyArgs
countSyll GWritingSystemPRPLX
wrs CharPhoneticClassification
arr String
us String
vs String
xs = GQtyArgs
numUnderscoresSyll GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
+ (Integer -> GQtyArgs
forall a. Enum a => a -> GQtyArgs
fromEnum (Integer -> GQtyArgs) -> (String -> Integer) -> String -> GQtyArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRS -> Integer -> Integer) -> Integer -> [PRS] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\PRS
x Integer
y -> if PRS -> Bool
createsSyllable PRS
x then Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 else Integer
y) Integer
0 ([PRS] -> Integer) -> (String -> [PRS]) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [PRS]) -> [String] -> [PRS]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CharPhoneticClassification -> String -> [PRS]
str2PRSs CharPhoneticClassification
arr) ([String] -> [PRS]) -> (String -> [String]) -> String -> [PRS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words1 (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe Char) -> String -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Char
g (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> String)
-> [PhoneticsRepresentationPLX] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PhoneticsRepresentationPLX -> String
string1 ([PhoneticsRepresentationPLX] -> String)
-> (String -> [PhoneticsRepresentationPLX]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs (String -> GQtyArgs) -> String -> GQtyArgs
forall a b. (a -> b) -> a -> b
$ String
xs)
   where numUnderscoresSyll :: GQtyArgs
numUnderscoresSyll = [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length ([String] -> GQtyArgs)
-> (String -> [String]) -> String -> GQtyArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
xs -> let (String
ys,String
ts) = GQtyArgs -> String -> (String, String)
forall a. GQtyArgs -> [a] -> ([a], [a])
splitAt GQtyArgs
1 String
xs in String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_" Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
ts Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ts)) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> String -> [String]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Char
x Char
y -> Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_' Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
y) (String -> GQtyArgs) -> String -> GQtyArgs
forall a b. (a -> b) -> a -> b
$ String
xs
         g :: Char -> Maybe Char
         g :: Char -> Maybe Char
g Char
x
          | Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
us = Maybe Char
forall a. Maybe a
Nothing
          | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
vs = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
          | Bool
otherwise = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' '
         words1 :: String -> [String]
words1 String
xs = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ts then [] else String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
words1 String
s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
           where ts :: String
ts = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
xs
                 (String
w, String
s'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
ts
         {-# NOINLINE words1 #-}

stat1 :: Int -> (Int8,[Int8]) -> Int
stat1 :: GQtyArgs -> (Int8, [Int8]) -> GQtyArgs
stat1 GQtyArgs
n (Int8
k, [Int8]
ks) = (GQtyArgs, GQtyArgs) -> GQtyArgs
forall a b. (a, b) -> a
fst (GQtyArgs
n GQtyArgs -> GQtyArgs -> (GQtyArgs, GQtyArgs)
`quotRemInt` Int8 -> GQtyArgs
forall a. Enum a => a -> GQtyArgs
fromEnum Int8
k) GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
* [Int8] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [Int8]
ks

outputSel :: PhladiprelioGen -> Int -> String
outputSel :: PhladiprelioGen -> GQtyArgs -> String
outputSel (S GQtyArgs
x1 Integer
y1 String
ts) GQtyArgs
code
  | GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
< GQtyArgs
0 = []
  | GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
1 Bool -> Bool -> Bool
|| GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
11 Bool -> Bool -> Bool
|| GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
16 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " [GQtyArgs -> String
forall a. Show a => a -> String
show GQtyArgs
x1, String
ts] String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\n"
  | GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
2 Bool -> Bool -> Bool
|| GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
12 Bool -> Bool -> Bool
|| GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
17 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " [Integer -> String
forall a. Show a => a -> String
show Integer
y1, String
ts] String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\n"
  | GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
3 Bool -> Bool -> Bool
|| GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
13 Bool -> Bool -> Bool
|| GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
18 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " [GQtyArgs -> String
forall a. Show a => a -> String
show GQtyArgs
x1, String
ts, Integer -> String
forall a. Show a => a -> String
show Integer
y1] String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\n"
  | GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
4 Bool -> Bool -> Bool
|| GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
14 Bool -> Bool -> Bool
|| GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
19 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " [GQtyArgs -> String
forall a. Show a => a -> String
show GQtyArgs
x1, Integer -> String
forall a. Show a => a -> String
show Integer
y1] String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\n"
  | Bool
otherwise = String
ts String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\n"

parseLineNumber :: Int -> IO Int
parseLineNumber :: GQtyArgs -> IO GQtyArgs
parseLineNumber GQtyArgs
l1 = do 
  String -> IO ()
putStrLn String
"Please, specify the number of the option to be written to the file specified: "
  String
number <- IO String
getLine
  let num :: Maybe GQtyArgs
num = String -> Maybe GQtyArgs
forall a. Read a => String -> Maybe a
readMaybe ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit String
number)::Maybe Int
  if Maybe GQtyArgs -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GQtyArgs
num Bool -> Bool -> Bool
|| Maybe GQtyArgs
num Maybe GQtyArgs -> Maybe GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
> GQtyArgs -> Maybe GQtyArgs
forall a. a -> Maybe a
Just GQtyArgs
l1 Bool -> Bool -> Bool
|| Maybe GQtyArgs
num Maybe GQtyArgs -> Maybe GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs -> Maybe GQtyArgs
forall a. a -> Maybe a
Just GQtyArgs
0 
      then GQtyArgs -> IO GQtyArgs
parseLineNumber GQtyArgs
l1 
      else GQtyArgs -> IO GQtyArgs
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GQtyArgs -> IO GQtyArgs)
-> (Maybe GQtyArgs -> GQtyArgs) -> Maybe GQtyArgs -> IO GQtyArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe GQtyArgs -> GQtyArgs
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe GQtyArgs -> IO GQtyArgs) -> Maybe GQtyArgs -> IO GQtyArgs
forall a b. (a -> b) -> a -> b
$ Maybe GQtyArgs
num

{-| Uses 'getArgs' inside to get the needed data from the command line arguments. Use with this in
 mind. 
-}
argsProcessing
 :: 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
 -> SegmentRulesG
 -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> ([[[PRS]]] -> [[Double]])
 -> [[String]]
 -> [[String]]
 -> String 
 -> IO (Int, Int, [Double], Bool, FilePath, String, String, String, Int, Bool, Int8, FilePath, Int, Bool, String, [String]) -- ^ These ones are intended to be used inside 'generalF'.
argsProcessing :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> [[String]]
-> [[String]]
-> String
-> IO
     (GQtyArgs, GQtyArgs, [Double], Bool, String, String, String,
      String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
      [String])
argsProcessing GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [[[PRS]]] -> [[Double]]
h [[String]]
ysss [[String]]
zsss String
xs = do
  [String]
args0 <- IO [String]
getArgs
  let (Args
argsC, [String]
args) = (Char, Char) -> CLSpecifications -> [String] -> (Args, [String])
takeCs1R (Char
'+',Char
'-') CLSpecifications
cSpecs [String]
args0
      (Args
argsB, [String]
args11) = CLSpecifications -> [String] -> (Args, [String])
takeBsR CLSpecifications
bSpecs [String]
args
      compareByLinesFinalFile :: String
compareByLinesFinalFile = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Args -> [String]) -> Args -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"-cm" (Args -> String) -> Args -> String
forall a b. (a -> b) -> a -> b
$ Args
argsB
  if Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
compareByLinesFinalFile then do
      GQtyArgs -> [String] -> String -> IO ()
compareFilesToOneCommon GQtyArgs
14 [String]
args11 String
compareByLinesFinalFile
      (GQtyArgs, GQtyArgs, [Double], Bool, String, String, String,
 String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
 [String])
-> IO
     (GQtyArgs, GQtyArgs, [Double], Bool, String, String, String,
      String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
      [String])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GQtyArgs
0,GQtyArgs
0,[],Bool
False,[],[],[],[],GQtyArgs
0,Bool
False,Int8
0,[],GQtyArgs
0,Bool
False,[],[]) 
  else do
    let prepare :: Bool
prepare = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-p") [String]
args11
        emptyline :: Bool
emptyline = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+l") [String]
args11 
        splitting :: Int8
splitting = Int8 -> Maybe Int8 -> Int8
forall a. a -> Maybe a -> a
fromMaybe Int8
50 (String -> Maybe Int8
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Args -> [String]) -> Args -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+w" (Args -> String) -> Args -> String
forall a b. (a -> b) -> a -> b
$ Args
argsB)::Maybe Int8) 
        concurrently :: Bool
concurrently = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-C") [String]
args11
        dcspecs :: [String]
dcspecs = String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+dc" Args
argsB
        (Bool
html,String
dcfile) 
          | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dcspecs = (Bool
False, String
"")
          | Bool
otherwise = ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
dcspecs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1",[String] -> String
forall a. HasCallStack => [a] -> a
last [String]
dcspecs)
        selStr :: String
selStr = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Args -> [String]) -> Args -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+ul" (Args -> String) -> Args -> String
forall a b. (a -> b) -> a -> b
$ Args
argsB
        filedata :: [String]
filedata = String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+f" Args
argsB
        power10' :: GQtyArgs
power10' = GQtyArgs -> Maybe GQtyArgs -> GQtyArgs
forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
4 (String -> Maybe GQtyArgs
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Args -> [String]) -> Args -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+q" (Args -> String) -> Args -> String
forall a b. (a -> b) -> a -> b
$ Args
argsB)::Maybe Int)
        power10 :: GQtyArgs
power10 
           | GQtyArgs
power10' GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
< GQtyArgs
2 Bool -> Bool -> Bool
&& GQtyArgs
power10' GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
> GQtyArgs
6 = GQtyArgs
4
           | Bool
otherwise = GQtyArgs
power10'
        ([String]
multiline2, GQtyArgs
multiline2LineNum)
          | String -> Args -> Bool
forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneB String
"+m3" Args
argsB =
              let r1ss :: [String]
r1ss = String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+m3" Args
argsB in
                    if [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
r1ss GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
3
                        then let ([String]
kss,[String]
qss) = GQtyArgs -> [String] -> ([String], [String])
forall a. GQtyArgs -> [a] -> ([a], [a])
splitAt GQtyArgs
2 [String]
r1ss in
                                     ([String]
kss, GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Ord a => a -> a -> a
max GQtyArgs
1 (GQtyArgs -> Maybe GQtyArgs -> GQtyArgs
forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
1 (String -> Maybe GQtyArgs
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
qss)::Maybe Int)))
                        else ([String]
r1ss, GQtyArgs
1)
          | String -> Args -> Bool
forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneB String
"+m2" Args
argsB = (String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+m" Args
argsB,  GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Ord a => a -> a -> a
max GQtyArgs
1 (GQtyArgs -> Maybe GQtyArgs -> GQtyArgs
forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
1 (String -> Maybe GQtyArgs
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Args -> [String]) -> Args -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+m2" (Args -> String) -> Args -> String
forall a b. (a -> b) -> a -> b
$ Args
argsB)::Maybe Int)))
          | Bool
otherwise = (String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+m" Args
argsB, -GQtyArgs
1)
        (String
fileread,GQtyArgs
lineNmb)
          | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
multiline2 = (String
"",-GQtyArgs
1)
          | [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
multiline2 GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
2 = ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
multiline2, GQtyArgs -> Maybe GQtyArgs -> GQtyArgs
forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
1 (String -> Maybe GQtyArgs
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall a. HasCallStack => [a] -> a
last [String]
multiline2)::Maybe Int))
          | Bool
otherwise = ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
multiline2, GQtyArgs
1)
    ([String]
arg3s,String
prestr,String
poststr,String
linecomp3) <- do
         if GQtyArgs
lineNmb GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
/= -GQtyArgs
1 then do
             String
txtFromFile <- String -> IO String
readFile String
fileread
             let lns :: [String]
lns = String -> [String]
lines String
txtFromFile
                 ll1 :: GQtyArgs
ll1 = [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
lns
                 ln0 :: GQtyArgs
ln0 = GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Ord a => a -> a -> a
max GQtyArgs
1 (GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Ord a => a -> a -> a
min GQtyArgs
lineNmb ([String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
lns))
                 lm3 :: GQtyArgs
lm3
                   | GQtyArgs
multiline2LineNum GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
< GQtyArgs
1 = -GQtyArgs
1
                   | Bool
otherwise = GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Ord a => a -> a -> a
max GQtyArgs
1 (GQtyArgs -> GQtyArgs)
-> (GQtyArgs -> GQtyArgs) -> GQtyArgs -> GQtyArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Ord a => a -> a -> a
min GQtyArgs
multiline2LineNum (GQtyArgs -> GQtyArgs) -> GQtyArgs -> GQtyArgs
forall a b. (a -> b) -> a -> b
$ GQtyArgs
ll1
                 linecomp3 :: String
linecomp3
                   | GQtyArgs
lm3 GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== -GQtyArgs
1 = []
                   | Bool
otherwise = [String]
lns [String] -> GQtyArgs -> String
forall a. HasCallStack => [a] -> GQtyArgs -> a
!! (GQtyArgs
lm3 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
- GQtyArgs
1)
                 ln_1 :: GQtyArgs
ln_1 
                    | GQtyArgs
ln0 GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
1 = GQtyArgs
0
                    | Bool
otherwise = GQtyArgs
ln0 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
- GQtyArgs
1
                 ln1 :: GQtyArgs
ln1
                    | GQtyArgs
ln0 GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
lns = GQtyArgs
0
                    | Bool
otherwise = GQtyArgs
ln0 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
+ GQtyArgs
1
                 lineF :: String
lineF = [String]
lns [String] -> GQtyArgs -> String
forall a. HasCallStack => [a] -> GQtyArgs -> a
!! (GQtyArgs
ln0 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
- GQtyArgs
1)
                 line_1F :: String
line_1F 
                    | GQtyArgs
ln_1 GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
0 = []
                    | Bool
otherwise = [String]
lns [String] -> GQtyArgs -> String
forall a. HasCallStack => [a] -> GQtyArgs -> a
!! (GQtyArgs
ln_1 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
- GQtyArgs
1)
                 line1F :: String
line1F
                    | GQtyArgs
ln1 GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
0 = []
                    | Bool
otherwise = [String]
lns [String] -> GQtyArgs -> String
forall a. HasCallStack => [a] -> GQtyArgs -> a
!! (GQtyArgs
ln1 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
- GQtyArgs
1)
             ([String], String, String, String)
-> IO ([String], String, String, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([String], String, String, String)
 -> IO ([String], String, String, String))
-> ([String], String, String, String)
-> IO ([String], String, String, String)
forall a b. (a -> b) -> a -> b
$ (String -> [String]
words String
lineF, String
line_1F,String
line1F,String
linecomp3)
         else ([String], String, String, String)
-> IO ([String], String, String, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
args11, [], [],[])
    let line2comparewith :: String
line2comparewith
          | String -> Args -> Bool
forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneC String
"+l2" Args
argsC Bool -> Bool -> Bool
|| String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
linecomp3 = [String] -> String
unwords ([String] -> String) -> (Args -> [String]) -> Args -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getC String
"+l2" (Args -> String) -> Args -> String
forall a b. (a -> b) -> a -> b
$ Args
argsC
          | Bool
otherwise = String
linecomp3
        basecomp :: [Double]
basecomp = (String -> Bool)
-> Double -> (String -> [Double]) -> String -> [Double]
read3 (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) Double
1.0 ([[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> (String -> [[Double]]) -> String -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PRS]]] -> [[Double]]
h ([[[PRS]]] -> [[Double]])
-> (String -> [[[PRS]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs) String
line2comparewith
        (String
filesave,GQtyArgs
codesave)
          | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
filedata = (String
"",-GQtyArgs
1)
          | [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
filedata GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
2 = ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
filedata, GQtyArgs -> Maybe GQtyArgs -> GQtyArgs
forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
0 (String -> Maybe GQtyArgs
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall a. HasCallStack => [a] -> a
last [String]
filedata)::Maybe Int))
          | Bool
otherwise = ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
filedata,GQtyArgs
0)
        ll :: [String]
ll = let maxWordsNum :: GQtyArgs
maxWordsNum = (if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+x") [String]
arg3s then GQtyArgs
9 else GQtyArgs
7) in GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
maxWordsNum ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
prepare then [String] -> [String]
forall a. a -> a
id else String -> [String]
words (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs
-> [[String]] -> [[String]] -> String -> String -> [String]
prepareTextN GQtyArgs
maxWordsNum [[String]]
ysss [[String]]
zsss String
xs (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]
arg3s
        l :: GQtyArgs
l = [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
ll
        argCs :: [EncodedCnstrs]
argCs = [Maybe EncodedCnstrs] -> [EncodedCnstrs]
forall a. [Maybe a] -> [a]
catMaybes ((String -> Maybe EncodedCnstrs)
-> [String] -> [Maybe EncodedCnstrs]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GQtyArgs -> String -> Maybe EncodedCnstrs
readMaybeECG GQtyArgs
l) ([String] -> [Maybe EncodedCnstrs])
-> (Args -> [String]) -> Args -> [Maybe EncodedCnstrs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getC String
"+a" (Args -> [Maybe EncodedCnstrs]) -> Args -> [Maybe EncodedCnstrs]
forall a b. (a -> b) -> a -> b
$ Args
argsC)
        argCBs :: String
argCBs = [String] -> String
unwords ([String] -> String) -> (Args -> [String]) -> Args -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getC String
"+b" (Args -> String) -> Args -> String
forall a b. (a -> b) -> a -> b
$ Args
argsC -- If you use the parenthese with +b ... -b then consider also using the quotation marks for the whole algebraic constraint. At the moment though it is still not working properly for parentheses functionality. The issue should be fixed in the further releases.
        !perms :: [Array GQtyArgs GQtyArgs]
perms 
          | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
argCBs) = GQtyArgs
-> String -> [Array GQtyArgs GQtyArgs] -> [Array GQtyArgs GQtyArgs]
filterGeneralConv GQtyArgs
l String
argCBs ([Array GQtyArgs GQtyArgs] -> [Array GQtyArgs GQtyArgs])
-> (GQtyArgs -> [Array GQtyArgs GQtyArgs])
-> GQtyArgs
-> [Array GQtyArgs GQtyArgs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [Array GQtyArgs GQtyArgs]
forall a. (Ord a, Enum a, Num a) => GQtyArgs -> [Array GQtyArgs a]
genPermutationsL (GQtyArgs -> [Array GQtyArgs GQtyArgs])
-> GQtyArgs -> [Array GQtyArgs GQtyArgs]
forall a b. (a -> b) -> a -> b
$ GQtyArgs
l
          | [EncodedCnstrs] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EncodedCnstrs]
argCs = GQtyArgs -> [Array GQtyArgs GQtyArgs]
forall a. (Ord a, Enum a, Num a) => GQtyArgs -> [Array GQtyArgs a]
genPermutationsL GQtyArgs
l
          | Bool
otherwise = [EncodedCnstrs]
-> [Array GQtyArgs GQtyArgs] -> [Array GQtyArgs GQtyArgs]
forall (t :: * -> *).
(InsertLeft t (Array GQtyArgs GQtyArgs),
 Monoid (t (Array GQtyArgs GQtyArgs))) =>
[EncodedCnstrs]
-> t (Array GQtyArgs GQtyArgs) -> t (Array GQtyArgs GQtyArgs)
decodeLConstraints [EncodedCnstrs]
argCs ([Array GQtyArgs GQtyArgs] -> [Array GQtyArgs GQtyArgs])
-> (GQtyArgs -> [Array GQtyArgs GQtyArgs])
-> GQtyArgs
-> [Array GQtyArgs GQtyArgs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [Array GQtyArgs GQtyArgs]
forall a. (Ord a, Enum a, Num a) => GQtyArgs -> [Array GQtyArgs a]
genPermutationsL (GQtyArgs -> [Array GQtyArgs GQtyArgs])
-> GQtyArgs -> [Array GQtyArgs GQtyArgs]
forall a b. (a -> b) -> a -> b
$ GQtyArgs
l 
        basiclineoption :: String
basiclineoption = [String] -> String
unwords [String]
arg3s
        example :: [Double]
example = (String -> Bool)
-> Double -> (String -> [Double]) -> String -> [Double]
read3 (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) Double
1.0 ([[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> (String -> [[Double]]) -> String -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PRS]]] -> [[Double]]
h ([[[PRS]]] -> [[Double]])
-> (String -> [[[PRS]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs) ([String] -> String
unwords [String]
arg3s)
        le :: GQtyArgs
le = [Double] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [Double]
example
        lb :: GQtyArgs
lb = [Double] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [Double]
basecomp
        gcd1 :: GQtyArgs
gcd1 = GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
gcd GQtyArgs
le GQtyArgs
lb
        ldc :: GQtyArgs
ldc = GQtyArgs
le GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
* GQtyArgs
lb GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
`quot` GQtyArgs
gcd1
        mulp :: GQtyArgs
mulp = GQtyArgs
ldc GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
`quot` GQtyArgs
lb
        max2 :: Double
max2 = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
basecomp
        compards :: [Double]
compards = (Double -> [Double]) -> [Double] -> [Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GQtyArgs -> Double -> [Double]
forall a. GQtyArgs -> a -> [a]
replicate GQtyArgs
mulp (Double -> [Double]) -> (Double -> Double) -> Double -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
max2)) [Double]
basecomp
        variants1 :: [String]
variants1 = Char
-> (String -> String)
-> ([String] -> [String])
-> (String -> String)
-> [Array GQtyArgs GQtyArgs]
-> [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 GQtyArgs GQtyArgs]
-> 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 GQtyArgs GQtyArgs]
perms [String]
ll
    (GQtyArgs, GQtyArgs, [Double], Bool, String, String, String,
 String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
 [String])
-> IO
     (GQtyArgs, GQtyArgs, [Double], Bool, String, String, String,
      String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
      [String])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GQtyArgs
power10, GQtyArgs
ldc, [Double]
compards, Bool
html, String
dcfile, String
selStr, String
prestr, String
poststr, GQtyArgs
lineNmb, Bool
emptyline, Int8
splitting, String
filesave, GQtyArgs
codesave, Bool
concurrently, String
basiclineoption, [String]
variants1)

processingF
 :: (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
 -> 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
 -> SegmentRulesG
 -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> ([[[PRS]]] -> [[Double]])
 -> Int
 -> HashCorrections 
 -> (Int8,[Int8]) 
 -> [[String]] 
 -> [[String]] 
 -> Bool
 -> Int -- ^ The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12. 
 -> String 
 -> IO ()
processingF :: (String -> String)
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> GQtyArgs
-> HashCorrections
-> (Int8, [Int8])
-> [[String]]
-> [[String]]
-> Bool
-> GQtyArgs
-> String
-> IO ()
processingF String -> String
selFun GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [[[PRS]]] -> [[Double]]
h GQtyArgs
numTest HashCorrections
hc (Int8
grps,[Int8]
mxms) [[String]]
ysss [[String]]
zsss Bool
descending GQtyArgs
hashStep String
xs = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> [[String]]
-> [[String]]
-> String
-> IO
     (GQtyArgs, GQtyArgs, [Double], Bool, String, String, String,
      String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
      [String])
argsProcessing GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [[[PRS]]] -> [[Double]]
h [[String]]
ysss [[String]]
zsss String
xs IO
  (GQtyArgs, GQtyArgs, [Double], Bool, String, String, String,
   String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
   [String])
-> ((GQtyArgs, GQtyArgs, [Double], Bool, String, String, String,
     String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
     [String])
    -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(GQtyArgs
power10, GQtyArgs
ldc, [Double]
compards, Bool
html, String
dcfile, String
selStr, String
prestr, String
poststr, GQtyArgs
lineNmb, Bool
emptyline, Int8
splitting, String
filesave, GQtyArgs
codesave, Bool
concurrently, String
basiclineoption, [String]
variants1) -> GQtyArgs
-> GQtyArgs
-> [Double]
-> Bool
-> String
-> String
-> (String -> String)
-> (String, String)
-> GQtyArgs
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> GQtyArgs
-> HashCorrections
-> (Int8, [Int8])
-> Bool
-> GQtyArgs
-> Bool
-> Int8
-> (String, GQtyArgs)
-> Bool
-> String
-> [String]
-> IO [String]
generalF GQtyArgs
power10 GQtyArgs
ldc [Double]
compards Bool
html String
dcfile String
selStr String -> String
selFun (String
prestr,String
poststr) GQtyArgs
lineNmb GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [[[PRS]]] -> [[Double]]
h GQtyArgs
numTest HashCorrections
hc (Int8
grps,[Int8]
mxms) Bool
descending GQtyArgs
hashStep Bool
emptyline Int8
splitting (String
filesave, GQtyArgs
codesave) Bool
concurrently String
basiclineoption [String]
variants1 IO [String] -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE processingF #-}

-- | Specifies the group of the command line arguments for 'processingF', which specifies the
-- PhLADiPreLiO constraints. For more information, see:
-- https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#constraints 
cSpecs :: CLSpecifications
cSpecs :: CLSpecifications
cSpecs = [String] -> [GQtyArgs] -> CLSpecifications
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"+a",String
"+b",String
"+l2"] ([GQtyArgs] -> CLSpecifications)
-> ([GQtyArgs] -> [GQtyArgs]) -> [GQtyArgs] -> CLSpecifications
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GQtyArgs] -> [GQtyArgs]
forall a. HasCallStack => [a] -> [a]
cycle ([GQtyArgs] -> CLSpecifications) -> [GQtyArgs] -> CLSpecifications
forall a b. (a -> b) -> a -> b
$ [-GQtyArgs
1]

bSpecs :: CLSpecifications
bSpecs :: CLSpecifications
bSpecs = [(String
"+f",GQtyArgs
2),(String
"+m",GQtyArgs
2),(String
"+m2",GQtyArgs
2),(String
"+m3",GQtyArgs
3),(String
"+ul",GQtyArgs
1),(String
"+w",GQtyArgs
1),(String
"+dc",GQtyArgs
2),(String
"+q",GQtyArgs
1),(String
"-cm",GQtyArgs
1)]

{-| 'selectSounds' converts the argument after \"+ul\" command line argument into a list of sound representations that is used for evaluation of \'uniqueness periods\' properties of the line. Is a modified Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2.parsey0Choice from the @phonetic-languages-simplified-generalized-examples-array-0.19.0.1@ package.
 -}
selectSounds 
  :: (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#selectSounds. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
  -> String 
  -> String
selectSounds :: (String -> String) -> String -> String
selectSounds String -> String
g String
xs = String -> String
forall {a}. Eq a => [a] -> [a]
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Ord a => [a] -> [a]
sort (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
g ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c  Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
' ' else Char
c) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
us
    where (String
_,String
us) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (String -> (String, 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]
filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'H' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'G') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String
xs
          f :: [a] -> [a]
f (a
x:ts :: [a]
ts@(a
y:[a]
_)) 
           | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a]
f [a]
ts
           | Bool
otherwise = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
f [a]
ts
          f [a]
xs = [a]
xs

-- | Internal part of the 'generalF' for processment in case of using tests mode.
testsOutput
  :: (Show a1, Integral a1) =>
     Bool
     -> Int
     -> (p -> [a2] -> Int8 -> [Int8] -> String -> a1)
     -> p
     -> Int
     -> [String]
     -> IO [String]
testsOutput :: forall a1 p a2.
(Show a1, Integral a1) =>
Bool
-> GQtyArgs
-> (p -> [a2] -> Int8 -> [Int8] -> String -> a1)
-> p
-> GQtyArgs
-> [String]
-> IO [String]
testsOutput Bool
concurrently GQtyArgs
syllN p -> [a2] -> Int8 -> [Int8] -> String -> a1
f p
ldc GQtyArgs
numTest [String]
universalSet = do
      String -> IO ()
putStrLn String
"Feet   Val  Stat   Proxim" 
      (if Bool
concurrently then ((Int8, [Int8]) -> IO String) -> [(Int8, [Int8])] -> IO [String]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently else ((Int8, [Int8]) -> IO String) -> [(Int8, [Int8])] -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM) 
           (\(Int8
q,[Int8]
qs) -> let m :: GQtyArgs
m = GQtyArgs -> (Int8, [Int8]) -> GQtyArgs
stat1 GQtyArgs
syllN (Int8
q,[Int8]
qs)
                           (String
min1,String
max1) = Maybe (String, String) -> (String, String)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (String, String) -> (String, String))
-> ([String] -> Maybe (String, String))
-> [String]
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Ordering)
-> [String] -> Maybe (String, String)
forall a (t :: * -> *).
(Ord a, Foldable t) =>
(a -> a -> Ordering) -> t a -> Maybe (a, a)
minMax11By ((String -> a1) -> String -> String -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (p -> [a2] -> Int8 -> [Int8] -> String -> a1
f p
ldc [] Int8
q [Int8]
qs)) ([String] -> (String, String)) -> [String] -> (String, String)
forall a b. (a -> b) -> a -> b
$ [String]
universalSet 
                           mx :: a1
mx = p -> [a2] -> Int8 -> [Int8] -> String -> a1
f p
ldc [] Int8
q [Int8]
qs String
max1
                           strTest :: String
strTest = (GQtyArgs -> String
forall a. Show a => a -> String
show (Int8 -> GQtyArgs
forall a. Enum a => a -> GQtyArgs
fromEnum Int8
q) String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"   |   " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend`  a1 -> String
forall a. Show a => a -> String
show a1
mx String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"     " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` GQtyArgs -> String
forall a. Show a => a -> String
show GQtyArgs
m String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"  -> " String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` Maybe GQtyArgs -> Double -> String -> String
forall a. RealFloat a => Maybe GQtyArgs -> a -> String -> String
showFFloat (GQtyArgs -> Maybe GQtyArgs
forall a. a -> Maybe a
Just GQtyArgs
3) (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* a1 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a1
mx Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ GQtyArgs -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral GQtyArgs
m) String
"%" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` (if GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
rem GQtyArgs
numTest GQtyArgs
10 GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
>= GQtyArgs
4 
                                                               then -- let min1 = minimumBy (comparing (f ldc [] q qs)) universalSet in 
                                                                     (String
"\n" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
min1 String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\n" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
max1 String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\n")  
                                                               else String
"")) in String -> IO ()
putStrLn String
strTest IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
strTest) ([(Int8, [Int8])] -> IO [String])
-> ([[Int8]] -> [(Int8, [Int8])]) -> [[Int8]] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int8] -> [[Int8]] -> [(Int8, [Int8])]
forall a b. [a] -> [b] -> [(a, b)]
zip (GQtyArgs -> [Int8]
sel2 GQtyArgs
numTest) ([[Int8]] -> IO [String]) -> [[Int8]] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (GQtyArgs -> [[Int8]]
sel GQtyArgs
numTest)

-- | Internal part of the 'generalF' for processment with a file.
outputWithFile
  :: (Eq a1, Num a1) =>
     ([[[PRS]]] -> [[Double]])
     -> 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
     -> SegmentRulesG
     -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
     -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
     -> String -- ^ If not null than instead of rhythmicity evaluation using hashes and and feets, there is computed a diversity property for the specified 'String' here using the 'selectSounds' function. For more information, see: 'https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types'
     -> [Double] -- ^ A list of non-negative values normed by 1.0 (the greatest of which is 1.0) that the line options are compared with. If null, then the program works as for version 0.12.1.0 without this newly-introduced argument since the version 0.13.0.0. The length of it must be a least common multiplier of the (number of syllables plus number of \'_digits\' groups) to work correctly. Is not used when the next 'FilePath' and 'String' arguments are not null.
     -> [PhladiprelioGen]
     -> Int
     -> a1
     -> FilePath -- ^ A file to be probably added output parts to.
     -> Int
     -> IO ()
outputWithFile :: forall a1.
(Eq a1, Num a1) =>
([[[PRS]]] -> [[Double]])
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [Double]
-> [PhladiprelioGen]
-> GQtyArgs
-> a1
-> String
-> GQtyArgs
-> IO ()
outputWithFile [[[PRS]]] -> [[Double]]
h GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs String
selStr [Double]
compards [PhladiprelioGen]
sRepresent GQtyArgs
code a1
grps String
fs GQtyArgs
num
  | Bool
mBool Bool -> Bool -> Bool
&& GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
>= GQtyArgs
10 Bool -> Bool -> Bool
&& GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
<= GQtyArgs
19 Bool -> Bool -> Bool
&& a1
grps a1 -> a1 -> Bool
forall a. Eq a => a -> a -> Bool
== a1
2 = String -> IO ()
putStrLn ([String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
textP, String
"\n", String
breaks, String
"\n", [Integer] -> String
forall a. Show a => a -> String
show [Integer]
rs]) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
appendF ((if GQtyArgs
code GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
>= GQtyArgs
15 then [String] -> String
forall a. Monoid a => [a] -> a
mconcat [[Integer] -> String
forall a. Show a => a -> String
show [Integer]
rs, String
"\n", String
breaks, String
"\n"] else String
"") String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
outputS)
  | Bool
otherwise = String -> IO ()
appendF String
outputS
           where mBool :: Bool
mBool = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
selStr Bool -> Bool -> Bool
&& [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
compards
                 appendF :: String -> IO ()
appendF = String -> String -> IO ()
appendFile String
fs
                 lineOption :: PhladiprelioGen
lineOption = [PhladiprelioGen] -> PhladiprelioGen
forall a. HasCallStack => [a] -> a
head ([PhladiprelioGen] -> PhladiprelioGen)
-> ([PhladiprelioGen] -> [PhladiprelioGen])
-> [PhladiprelioGen]
-> PhladiprelioGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhladiprelioGen -> Bool) -> [PhladiprelioGen] -> [PhladiprelioGen]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(S GQtyArgs
k Integer
_ String
_) -> GQtyArgs
k GQtyArgs -> GQtyArgs -> Bool
forall a. Eq a => a -> a -> Bool
== GQtyArgs
num) ([PhladiprelioGen] -> PhladiprelioGen)
-> [PhladiprelioGen] -> PhladiprelioGen
forall a b. (a -> b) -> a -> b
$ [PhladiprelioGen]
sRepresent
                 textP :: String
textP = (\(S GQtyArgs
_ Integer
_ String
ts) -> String
ts) PhladiprelioGen
lineOption
                 outputS :: String
outputS = PhladiprelioGen -> GQtyArgs -> String
outputSel PhladiprelioGen
lineOption GQtyArgs
code
                 qqs :: [(String, Double)]
qqs = (String -> [Double])
-> (String -> [String]) -> Seq Read0 -> [(String, Double)]
readEq4 ([[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> (String -> [[Double]]) -> String -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PRS]]] -> [[Double]]
h ([[[PRS]]] -> [[Double]])
-> (String -> [[[PRS]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs) (([PRS] -> String) -> [[PRS]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((PRS -> Char) -> [PRS] -> String
forall a b. (a -> b) -> [a] -> [b]
map PRS -> Char
charS) ([[PRS]] -> [String]) -> (String -> [[PRS]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PRS]]] -> [[PRS]]
forall a. Monoid a => [a] -> a
mconcat ([[[PRS]]] -> [[PRS]])
-> (String -> [[[PRS]]]) -> String -> [[PRS]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs) (Seq Read0 -> [(String, Double)])
-> (String -> Seq Read0) -> String -> [(String, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Seq Read0
basicSplit (String -> [(String, Double)]) -> String -> [(String, Double)]
forall a b. (a -> b) -> a -> b
$ String
textP
                 (String
breaks,[Integer]
rs) = [(String, Double)] -> (String, [Integer])
showZerosFor2PeriodMusic [(String, Double)]
qqs