{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Aftovolio.General.Simple where

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

generalF ::
    -- | A power of 10. The resulting distance using next ['Word8'] argument is quoted by 10 in this power. The default one is 0. The proper values are in the range [0..4].
    Int ->
    -- | A 'length' of the next argument here.
    Int ->
    -- | A value that the different options are compared with. If no command line argument \"+di\" was added, then this is a `C1` applied to the list of positive values normed by 255 (the greatest of which is 255) that the line options are compared with. If null, then the program works without comparison. 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. If \"+di\" command line argument was  provided, then this corresponds to the case of differentiation.
    Compards ->
    -- | If 'True' then adds \"<br>\" to line endings for double column output
    Bool ->
    -- | Whether to filter out all groups of \'={digits}\' from the lines.
    Bool ->
    -- | A path to the file to save double columns output to. If empty then just prints to 'stdout'.
    FilePath ->
    -- | 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 ->
    -- | 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.
    (String, String) ->
    -- | 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.
    Int ->
    -- | Data used to obtain the phonetic language representation of the text.
    GWritingSystemPRPLX ->
    -- | 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.
    [(Char, Char)] ->
    CharPhoneticClassification ->
    SegmentRulesG ->
    -- | Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
    BasicSpaces ->
    -- | Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
    AdditionalDelimiters ->
    -- | See the conversion function 'Aftovolio.General.Datatype3.zippedDouble2Word8'. It is easier to obtain the function @f::[[[PhoneticPhenomenonRep]]]->[[Double]]@, and, afterwards, you can use 'zippedDouble2Word8' to transform the main semantic kernel of [(PhoneticPhenomenonRep, Double)] into [(PhoneticPhenomenonRep, Word8)]. For more information, see 'https://hackage.haskell.org/package/aftovolio-0.6.2.0/src/README.md' in the section 'Ability to use your own durations of representations of sounds or phonetic phenomena'.
    ([[[PhoneticPhenomenonRep]]] -> [[Word8]]) ->
    Int ->
    HashCorrections ->
    (Int8, [Int8]) ->
    -- | The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12.
    Int ->
    Bool ->
    Int8 ->
    (FilePath, Int) ->
    -- | 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.
    Bool ->
    -- | An initial string to be analyzed.
    String ->
    -- | A list of line numbers of the Aftovolio data to be displayed in the modes except tests and file appending.
    [Int] -> 
    [String] ->
    IO [String]
generalF :: GQtyArgs
-> GQtyArgs
-> Compards
-> Bool
-> Bool
-> String
-> String
-> (String -> String)
-> (String, String)
-> GQtyArgs
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> GQtyArgs
-> HashCorrections
-> (Int8, [Int8])
-> GQtyArgs
-> Bool
-> Int8
-> (String, GQtyArgs)
-> Bool
-> String
-> [GQtyArgs]
-> [String]
-> IO [String]
generalF GQtyArgs
power10 GQtyArgs
ldc Compards
compards Bool
html Bool
filtering String
dcfile String
selStr String -> String
selFun (String
prestr, String
poststr) GQtyArgs
lineNmb GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h GQtyArgs
numTest HashCorrections
hc (Int8
grps, [Int8]
mxms) GQtyArgs
hashStep Bool
emptyline Int8
splitting (String
fs, GQtyArgs
code) Bool
concurrently String
initstr [GQtyArgs]
lineNumbersSel [String]
universalSet
    | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.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
writingSystem CharPhoneticClassification
arrCharClassification String
basicSpaces String
additionalDelims String
initstr
            f :: p -> Compards -> Int8 -> [Int8] -> String -> Integer
f p
ldc Compards
compards Int8
grps [Int8]
mxms
                | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
selStr =
                    ( if ([Word8] -> Bool) -> ([Int8] -> Bool) -> Compards -> Bool
forall a b c d.
DoubleFunc a b c d =>
(a -> c) -> (b -> c) -> d -> c
doubleFunc ([Word8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null :: [Word8] -> Bool) ([Int8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null :: [Int8] -> Bool) Compards
compards
                        then ([Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer)
-> ([Word8] -> [Integer]) -> [Word8] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs
-> HashCorrections -> Int8 -> [Int8] -> [Word8] -> [Integer]
forall a.
Ord a =>
GQtyArgs -> HashCorrections -> Int8 -> [Int8] -> [a] -> [Integer]
countHashes2G GQtyArgs
hashStep HashCorrections
hc Int8
grps [Int8]
mxms)
                        else
                            (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
10 Integer -> GQtyArgs -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ GQtyArgs
power10)
                                (Integer -> Integer) -> ([Word8] -> Integer) -> [Word8] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                                (Integer -> Integer) -> ([Word8] -> Integer) -> [Word8] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compards -> Compards -> Integer
sumAbsDistNormComp Compards
compards
                                (Compards -> Integer)
-> ([Word8] -> Compards) -> [Word8] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Compards -> Bool
isWord8Based Compards
compards then [Word8] -> Compards
C1 else [Int8] -> Compards
C2 ([Int8] -> Compards) -> ([Word8] -> [Int8]) -> [Word8] -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Int8]
fromSmallWord8toInt8Diff)
                    )
                        ([Word8] -> Integer) -> (String -> [Word8]) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool)
-> Double -> (String -> [Word8]) -> String -> [Word8]
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
L.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
                            ([[Word8]] -> [Word8]
forall a. Monoid a => [a] -> a
mconcat ([[Word8]] -> [Word8])
-> (String -> [[Word8]]) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> (String -> [[[PhoneticPhenomenonRep]]]) -> String -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PhoneticPhenomenonRep]]]
createSyllablesPL GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims)
                | 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
basicSpaces String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
additionalDelims)
                        (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
writingSystem
                        (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
&& ([Word8] -> Bool) -> ([Int8] -> Bool) -> Compards -> Bool
forall a b c d.
DoubleFunc a b c d =>
(a -> c) -> (b -> c) -> d -> c
doubleFunc ([Word8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null :: [Word8] -> Bool) ([Int8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null :: [Int8] -> Bool) Compards
compards
            then Bool
-> GQtyArgs
-> Bool
-> (GQtyArgs -> Compards -> Int8 -> [Int8] -> String -> Integer)
-> GQtyArgs
-> GQtyArgs
-> [String]
-> IO [String]
forall a1.
(Show a1, Integral a1) =>
Bool
-> GQtyArgs
-> Bool
-> (GQtyArgs -> Compards -> Int8 -> [Int8] -> String -> a1)
-> GQtyArgs
-> GQtyArgs
-> [String]
-> IO [String]
testsOutput Bool
concurrently GQtyArgs
syllN Bool
filtering GQtyArgs -> Compards -> Int8 -> [Int8] -> String -> Integer
forall {p}. p -> Compards -> Int8 -> [Int8] -> String -> Integer
f GQtyArgs
ldc GQtyArgs
numTest [String]
universalSet
            else
                let lgth :: GQtyArgs
lgth = [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
universalSet
                    sRepresent :: [AftovolioGen]
sRepresent =
                        (GQtyArgs -> (Integer, String) -> AftovolioGen)
-> [GQtyArgs] -> [(Integer, String)] -> [AftovolioGen]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\GQtyArgs
k (Integer
x, String
ys) -> GQtyArgs -> Integer -> String -> AftovolioGen
S GQtyArgs
k Integer
x String
ys) [GQtyArgs
1 ..]
                            ([(Integer, String)] -> [AftovolioGen])
-> ([String] -> [(Integer, String)]) -> [String] -> [AftovolioGen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, String) -> (Integer, String))
-> [(Integer, String)] -> [(Integer, String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Integer, String) -> (Integer, String)
forall a. a -> a
id
                            ([(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 -> Compards -> Int8 -> [Int8] -> String -> Integer
forall {p}. p -> Compards -> Int8 -> [Int8] -> String -> Integer
f GQtyArgs
ldc Compards
compards Int8
grps [Int8]
mxms String
xss, String
xss))
                            ([String] -> [AftovolioGen]) -> [String] -> [AftovolioGen]
forall a b. (a -> b) -> a -> b
$ [String]
universalSet
                    strOutput :: [String]
strOutput 
                        | [GQtyArgs] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [GQtyArgs]
lineNumbersSel =
                        [String] -> [String]
forall a. NFData a => a -> a
force
                            ([String] -> [String])
-> ([AftovolioGen] -> [String]) -> [AftovolioGen] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
L.lines
                            (String -> [String])
-> ([AftovolioGen] -> String) -> [AftovolioGen] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AftovolioGen -> Integer)
-> Bool -> String -> Int8 -> [AftovolioGen] -> String
forall a b.
(Show a, Eq b) =>
(a -> b) -> Bool -> String -> Int8 -> [a] -> String
halfsplit1G
                                (\(S GQtyArgs
_ Integer
y String
_) -> Integer
y)
                                Bool
filtering
                                (if Bool
html then String
"<br>" else String
"")
                                (Int8 -> Int8
forall {a}. Integral a => a -> a
jjj Int8
splitting) ([AftovolioGen] -> [String]) -> [AftovolioGen] -> [String]
forall a b. (a -> b) -> a -> b
$
                            [AftovolioGen]
sRepresent
                        | Bool
otherwise = 
                         [String] -> [String]
forall a. NFData a => a -> a
force 
                             ([String] -> [String])
-> ([AftovolioGen] -> [String]) -> [AftovolioGen] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (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
L.null)
                             ([String] -> [String])
-> ([AftovolioGen] -> [String]) -> [AftovolioGen] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AftovolioGen -> String) -> [AftovolioGen] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (S GQtyArgs
k Integer
_ String
qqs) -> if (GQtyArgs
k GQtyArgs -> [GQtyArgs] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GQtyArgs]
lineNumbersSel Bool -> Bool -> Bool
&& GQtyArgs
k GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
<= GQtyArgs
lgth) then String
qqs else [])
                             ([AftovolioGen] -> [String]) -> [AftovolioGen] -> [String]
forall a b. (a -> b) -> a -> b
$ [AftovolioGen]
sRepresent
                    lns1 :: String
lns1 = [String] -> String
unlines [String]
strOutput
                 in do
                        if [GQtyArgs] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [GQtyArgs]
lineNumbersSel then do
                             String -> IO ()
putStrLn String
lns1
                             if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.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
"Aftovolio.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
"Aftovolio.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 = [AftovolioGen] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [AftovolioGen]
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
                                             Bool -> String -> String -> GQtyArgs -> [String] -> IO ()
print23 Bool
filtering 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
                                     Bool -> String -> String -> GQtyArgs -> [String] -> IO ()
print23 Bool
filtering 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
                                         permiss <- String -> IO Permissions
getPermissions String
fs
                                         let writ = Permissions -> Bool
writable Permissions
permiss
                                             readab = Permissions -> Bool
readable Permissions
permiss
                                         if writ && readab
                                             then outputWithFile h writingSystem allophones arrCharClassification segmentRules basicSpaces additionalDelims selStr compards sRepresent code grps fs num
                                             else
                                                 error
                                                     "The specified file cannot be used for appending the text! Please, specify another file!"
                                         return strOutput
                        else (String -> IO ()) -> [String] -> IO [()]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO ()
putStrLn [String]
strOutput 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]
strOutput          
  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
10 a -> 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
10 a -> 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
10 a -> 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
10 a -> 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 AftovolioGen = S !Int !Integer !String deriving (AftovolioGen -> AftovolioGen -> Bool
(AftovolioGen -> AftovolioGen -> Bool)
-> (AftovolioGen -> AftovolioGen -> Bool) -> Eq AftovolioGen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AftovolioGen -> AftovolioGen -> Bool
== :: AftovolioGen -> AftovolioGen -> Bool
$c/= :: AftovolioGen -> AftovolioGen -> Bool
/= :: AftovolioGen -> AftovolioGen -> Bool
Eq, (forall x. AftovolioGen -> Rep AftovolioGen x)
-> (forall x. Rep AftovolioGen x -> AftovolioGen)
-> Generic AftovolioGen
forall x. Rep AftovolioGen x -> AftovolioGen
forall x. AftovolioGen -> Rep AftovolioGen x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AftovolioGen -> Rep AftovolioGen x
from :: forall x. AftovolioGen -> Rep AftovolioGen x
$cto :: forall x. Rep AftovolioGen x -> AftovolioGen
to :: forall x. Rep AftovolioGen x -> AftovolioGen
Generic)

instance Show AftovolioGen where
    show :: AftovolioGen -> 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

instance NFData AftovolioGen

countSyll ::
    -- | Data used to obtain the phonetic language representation of the text.
    GWritingSystemPRPLX ->
    CharPhoneticClassification ->
    -- | Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
    BasicSpaces ->
    -- | Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
    AdditionalDelimiters ->
    String ->
    Int
countSyll :: GWritingSystemPRPLX
-> CharPhoneticClassification
-> String
-> String
-> String
-> GQtyArgs
countSyll GWritingSystemPRPLX
writingSystem CharPhoneticClassification
arrCharClassification String
basicSpaces String
additionalDelims 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
. (PhoneticPhenomenonRep -> Integer -> Integer)
-> Integer -> [PhoneticPhenomenonRep] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\PhoneticPhenomenonRep
x Integer
y -> if PhoneticPhenomenonRep -> Bool
createsSyllable PhoneticPhenomenonRep
x then Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 else Integer
y) Integer
0
                ([PhoneticPhenomenonRep] -> Integer)
-> (String -> [PhoneticPhenomenonRep]) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [PhoneticPhenomenonRep])
-> [String] -> [PhoneticPhenomenonRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CharPhoneticClassification -> String -> [PhoneticPhenomenonRep]
str2PRSs CharPhoneticClassification
arrCharClassification)
                ([String] -> [PhoneticPhenomenonRep])
-> (String -> [String]) -> String -> [PhoneticPhenomenonRep]
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
writingSystem (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
L.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
x Char -> 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
basicSpaces = 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
additionalDelims = 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
L.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 :: AftovolioGen -> Int -> String
outputSel :: AftovolioGen -> 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: "
    number <- IO String
getLine
    let 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 isNothing num || num > Just l1 || num == Just 0
        then parseLineNumber l1
        else return . fromJust $ num

{- | Uses 'getArgs' inside to get the needed data from the command line arguments. Use with this in
 mind.
-}
argsProcessing ::
    -- | Data used to obtain the phonetic language representation of the text.
    GWritingSystemPRPLX ->
    -- | 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.
    [(Char, Char)] ->
    CharPhoneticClassification ->
    SegmentRulesG ->
    -- | Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
    BasicSpaces ->
    -- | Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
    AdditionalDelimiters ->
    -- | See the conversion function 'Aftovolio.General.Datatype3.zippedDouble2Word8'. It is easier to obtain the function @f::[[[PhoneticPhenomenonRep]]]->[[Double]]@, and, afterwards, you can use 'zippedDouble2Word8' to transform the main semantic kernel of [(PhoneticPhenomenonRep, Double)] into [(PhoneticPhenomenonRep, Word8)]. For more information, see 'https://hackage.haskell.org/package/aftovolio-0.6.2.0/src/README.md' in the section 'Ability to use your own durations of representations of sounds or phonetic phenomena'.
    ([[[PhoneticPhenomenonRep]]] -> [[Word8]]) ->
    [[String]] -> -- ^ Is intended to become a valid 'Concatenations' that are to be prepended to the next word.
    [[String]] -> -- ^ Is intended to become a valid 'Concatenations' that are to be appended to the previous word
    String ->
    -- | These ones are intended to be used inside 'generalF'.
    IO
        ( Int
        , Int
        , Compards
        , Bool
        , Bool
        , FilePath
        , String
        , String
        , String
        , Int
        , Bool
        , Int8
        , FilePath
        , Int
        , Bool
        , String
        , [Int]
        , [String]
        )
argsProcessing :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> [[String]]
-> [[String]]
-> String
-> IO
     (GQtyArgs, GQtyArgs, Compards, Bool, Bool, String, String, String,
      String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
      [GQtyArgs], [String])
argsProcessing GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h [[String]]
ysss [[String]]
zsss String
xs = do
    args0 <- IO [String]
getArgs
    let (argsC, args) = takeCs1R ('+', '-') cSpecs args0
        (argsB, args11) = takeBsR bSpecs args
        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 not . L.null $ compareByLinesFinalFile
        then do
            compareFilesToOneCommon 14 args11 compareByLinesFinalFile
            return (0, 0, (C1 []), False, False, [], [], [], [], 0, False, 0, [], 0, False, [], [], [])
        else do
            let 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 = (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 -> Maybe Int8 -> Int8
forall a. a -> Maybe a -> a
fromMaybe Int8
54 (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 = (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
                filtering = (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
"-e") [String]
args11
                dcspecs = String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+dc" Args
argsB
                (html, dcfile)
                    | L.null dcspecs = (False, "")
                    | otherwise = (head dcspecs == "1", last dcspecs)
                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 -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+f" Args
argsB
                power10' = 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 (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 -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
< GQtyArgs
0 Bool -> Bool -> Bool
&& GQtyArgs
power10' GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
> GQtyArgs
4 = GQtyArgs
0
                    | Bool
otherwise = GQtyArgs
power10'
                (multiline2, multiline2LineNum)
                    | oneB "+m3" argsB =
                        let r1ss = String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+m3" Args
argsB
                         in if length r1ss == 3
                                then
                                    let (kss, qss) = splitAt 2 r1ss
                                     in (kss, max 1 (fromMaybe 1 (readMaybe (concat qss) :: Maybe Int)))
                                else (r1ss, 1)
                    | oneB "+m2" argsB =
                        ( getB "+m" argsB
                        , max 1 (fromMaybe 1 (readMaybe (concat . getB "+m2" $ argsB) :: Maybe Int))
                        )
                    | otherwise = (getB "+m" argsB, -1)
                (fileread, lineNmb)
                    | L.null multiline2 = ("", -1)
                    | length multiline2 == 2 =
                        (head multiline2, fromMaybe 1 (readMaybe (last multiline2) :: Maybe Int))
                    | otherwise = (head multiline2, 1)
            (arg3s, prestr, poststr, linecomp3) <- do
                if lineNmb /= -1
                    then do
                        txtFromFile <- readFile fileread
                        let lns = String -> [String]
lines String
txtFromFile
                            ll1 = [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
lns
                            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
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
                                | 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
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
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]
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
                                | 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
                                | 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)
                        return $ (words lineF, line_1F, line1F, linecomp3)
                    else return (args11, [], [], [])
            let differentiate = (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
"+di") [String]
args11
                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
L.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
                    | String -> Args -> Bool
forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneC String
"+ln" Args
argsC =
                        (if Bool
differentiate then [Int8] -> Compards
C2 ([Int8] -> Compards) -> ([Word8] -> [Int8]) -> [Word8] -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Int8]
fromSmallWord8toInt8Diff else [Word8] -> Compards
C1)
                            ([Word8] -> Compards) -> (Args -> [Word8]) -> Args -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Word8] -> [Word8]
forall a. [Maybe a] -> [a]
catMaybes
                            ([Maybe Word8] -> [Word8])
-> (Args -> [Maybe Word8]) -> Args -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe Word8) -> [String] -> [Maybe Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> String -> Maybe Word8
forall a. Read a => String -> Maybe a
readMaybe String
xs :: Maybe Word8)
                            ([String] -> [Maybe Word8])
-> (Args -> [String]) -> Args -> [Maybe Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getC String
"+ln" (Args -> Compards) -> Args -> Compards
forall a b. (a -> b) -> a -> b
$
                            Args
argsC -- to read positive Word8 values as a list of them.
                    | Bool
otherwise =
                        (if Bool
differentiate then [Int8] -> Compards
C2 ([Int8] -> Compards) -> ([Word8] -> [Int8]) -> [Word8] -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Int8]
fromSmallWord8toInt8Diff else [Word8] -> Compards
C1)
                            ([Word8] -> Compards) -> (String -> [Word8]) -> String -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool)
-> Double -> (String -> [Word8]) -> String -> [Word8]
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
L.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
                                ([[Word8]] -> [Word8]
forall a. Monoid a => [a] -> a
mconcat ([[Word8]] -> [Word8])
-> (String -> [[Word8]]) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> (String -> [[[PhoneticPhenomenonRep]]]) -> String -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PhoneticPhenomenonRep]]]
createSyllablesPL GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims) (String -> Compards) -> String -> Compards
forall a b. (a -> b) -> a -> b
$
                            String
line2comparewith
                (filesave, codesave)
                    | L.null filedata = ("", -1)
                    | length filedata == 2 =
                        (head filedata, fromMaybe 0 (readMaybe (last filedata) :: Maybe Int))
                    | otherwise = (head filedata, 0)
                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 = [String] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length [String]
ll
                lineNumbersSel = [String] -> [GQtyArgs]
readNums ([String] -> [GQtyArgs])
-> (Args -> [String]) -> Args -> [GQtyArgs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getC String
"+nm" (Args -> [GQtyArgs]) -> Args -> [GQtyArgs]
forall a b. (a -> b) -> a -> b
$ Args
argsC
                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] -> 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.
                permutationsType = [String] -> PermutationsType
bTransform2Perms ([String] -> PermutationsType)
-> (Args -> [String]) -> Args -> PermutationsType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+P" (Args -> PermutationsType) -> Args -> PermutationsType
forall a b. (a -> b) -> a -> b
$ Args
argsB
                !perms
                    | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.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
. PermutationsType -> GQtyArgs -> [Array GQtyArgs GQtyArgs]
permChoose PermutationsType
permutationsType (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
L.null [EncodedCnstrs]
argCs = PermutationsType -> GQtyArgs -> [Array GQtyArgs GQtyArgs]
permChoose PermutationsType
permutationsType 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
. PermutationsType -> GQtyArgs -> [Array GQtyArgs GQtyArgs]
permChoose PermutationsType
permutationsType (GQtyArgs -> [Array GQtyArgs GQtyArgs])
-> GQtyArgs -> [Array GQtyArgs GQtyArgs]
forall a b. (a -> b) -> a -> b
$ GQtyArgs
l
                basiclineoption = [String] -> String
unwords [String]
arg3s
                example =
                    (if Bool
differentiate then [Int8] -> Compards
C2 ([Int8] -> Compards) -> ([Word8] -> [Int8]) -> [Word8] -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Int8]
fromSmallWord8toInt8Diff else [Word8] -> Compards
C1)
                        ([Word8] -> Compards)
-> ([String] -> [Word8]) -> [String] -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool)
-> Double -> (String -> [Word8]) -> String -> [Word8]
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
L.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
                            ([[Word8]] -> [Word8]
forall a. Monoid a => [a] -> a
mconcat ([[Word8]] -> [Word8])
-> (String -> [[Word8]]) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> (String -> [[[PhoneticPhenomenonRep]]]) -> String -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PhoneticPhenomenonRep]]]
createSyllablesPL GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims)
                        (String -> [Word8]) -> ([String] -> String) -> [String] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> Compards) -> [String] -> Compards
forall a b. (a -> b) -> a -> b
$
                        [String]
arg3s
                le = ([Word8] -> GQtyArgs)
-> ([Int8] -> GQtyArgs) -> Compards -> GQtyArgs
forall a b c d.
DoubleFunc a b c d =>
(a -> c) -> (b -> c) -> d -> c
doubleFunc ([Word8] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length :: [Word8] -> Int) ([Int8] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length :: [Int8] -> Int) Compards
example
                lb = ([Word8] -> GQtyArgs)
-> ([Int8] -> GQtyArgs) -> Compards -> GQtyArgs
forall a b c d.
DoubleFunc a b c d =>
(a -> c) -> (b -> c) -> d -> c
doubleFunc ([Word8] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length :: [Word8] -> Int) ([Int8] -> GQtyArgs
forall a. [a] -> GQtyArgs
forall (t :: * -> *) a. Foldable t => t a -> GQtyArgs
length :: [Int8] -> Int) Compards
basecomp
                gcd1 = GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
gcd GQtyArgs
le GQtyArgs
lb
                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
ldc GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
`quot` GQtyArgs
lb
                --        max2 = maximum basecomp
                compards =
                    let ff :: ([Word8] -> [Word8]) -> ([Int8] -> [Int8]) -> Compards -> Compards
ff [Word8] -> [Word8]
g1 [Int8] -> [Int8]
g2 Compards
ks =
                            if Compards -> Bool
isWord8Based Compards
ks
                                then [Word8] -> Compards
C1 ([Word8] -> Compards)
-> (Compards -> [Word8]) -> Compards -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
g1 ([Word8] -> [Word8])
-> (Compards -> [Word8]) -> Compards -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(C1 [Word8]
us) -> [Word8]
us) (Compards -> Compards) -> Compards -> Compards
forall a b. (a -> b) -> a -> b
$ Compards
ks
                                else [Int8] -> Compards
C2 ([Int8] -> Compards)
-> (Compards -> [Int8]) -> Compards -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int8] -> [Int8]
g2 ([Int8] -> [Int8]) -> (Compards -> [Int8]) -> Compards -> [Int8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(C2 [Int8]
us) -> [Int8]
us) (Compards -> Compards) -> Compards -> Compards
forall a b. (a -> b) -> a -> b
$ Compards
ks
                     in ([Word8] -> [Word8]) -> ([Int8] -> [Int8]) -> Compards -> Compards
ff ((Word8 -> [Word8]) -> [Word8] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GQtyArgs -> Word8 -> [Word8]
forall a. GQtyArgs -> a -> [a]
replicate GQtyArgs
mulp)) ((Int8 -> [Int8]) -> [Int8] -> [Int8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GQtyArgs -> Int8 -> [Int8]
forall a. GQtyArgs -> a -> [a]
replicate GQtyArgs
mulp)) Compards
basecomp
                variants1 = [String] -> [String]
forall a. NFData a => a -> a
force ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
ll
            return
                ( power10
                , ldc
                , compards
                , html
                , filtering
                , dcfile
                , selStr
                , prestr
                , poststr
                , lineNmb
                , emptyline
                , splitting
                , filesave
                , codesave
                , concurrently
                , basiclineoption
                , lineNumbersSel
                , variants1
                )

processingF ::
    -- | 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.
    (String -> String) ->
    -- | Data used to obtain the phonetic language representation of the text.
    GWritingSystemPRPLX ->
    -- | 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.
    [(Char, Char)] ->
    CharPhoneticClassification ->
    SegmentRulesG ->
    -- | Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
    BasicSpaces ->
    -- | Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
    AdditionalDelimiters ->
    -- | See the conversion function 'Aftovolio.General.Datatype3.zippedDouble2Word8'. It is easier to obtain the function @f::[[[PhoneticPhenomenonRep]]]->[[Double]]@, and, afterwards, you can use 'zippedDouble2Word8' to transform the main semantic kernel of [(PhoneticPhenomenonRep, Double)] into [(PhoneticPhenomenonRep, Word8)]. For more information, see 'https://hackage.haskell.org/package/aftovolio-0.6.2.0/src/README.md' in the section 'Ability to use your own durations of representations of sounds or phonetic phenomena'.
    ([[[PhoneticPhenomenonRep]]] -> [[Word8]]) ->
    Int ->
    HashCorrections ->
    (Int8, [Int8]) ->
    [[String]] -> -- ^ Is intended to become a valid 'Concatenations' that are to be prepended to the next word.
    [[String]] -> -- ^ Is intended to become a valid 'Concatenations' that are to be appended to the previous word
    -- | The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12.
    Int ->
    String ->
    IO ()
processingF :: (String -> String)
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> GQtyArgs
-> HashCorrections
-> (Int8, [Int8])
-> [[String]]
-> [[String]]
-> GQtyArgs
-> String
-> IO ()
processingF String -> String
selFun GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h GQtyArgs
numTest HashCorrections
hc (Int8
grps, [Int8]
mxms) [[String]]
ysss [[String]]
zsss GQtyArgs
hashStep String
xs =
    GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> [[String]]
-> [[String]]
-> String
-> IO
     (GQtyArgs, GQtyArgs, Compards, Bool, Bool, String, String, String,
      String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
      [GQtyArgs], [String])
argsProcessing GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h [[String]]
ysss [[String]]
zsss String
xs IO
  (GQtyArgs, GQtyArgs, Compards, Bool, Bool, String, String, String,
   String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool, String,
   [GQtyArgs], [String])
-> ((GQtyArgs, GQtyArgs, Compards, Bool, Bool, String, String,
     String, String, GQtyArgs, Bool, Int8, String, GQtyArgs, Bool,
     String, [GQtyArgs], [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
                                                            , Compards
compards
                                                            , Bool
html
                                                            , Bool
filtering
                                                            , String
dcfile
                                                            , String
selStr
                                                            , String
prestr
                                                            , String
poststr
                                                            , GQtyArgs
lineNmb
                                                            , Bool
emptyline
                                                            , Int8
splitting
                                                            , String
filesave
                                                            , GQtyArgs
codesave
                                                            , Bool
concurrently
                                                            , String
basiclineoption
                                                            , [GQtyArgs]
lineNumbersSel
                                                            , [String]
variants1
                                                            ) ->
        GQtyArgs
-> GQtyArgs
-> Compards
-> Bool
-> Bool
-> String
-> String
-> (String -> String)
-> (String, String)
-> GQtyArgs
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> GQtyArgs
-> HashCorrections
-> (Int8, [Int8])
-> GQtyArgs
-> Bool
-> Int8
-> (String, GQtyArgs)
-> Bool
-> String
-> [GQtyArgs]
-> [String]
-> IO [String]
generalF
            GQtyArgs
power10
            GQtyArgs
ldc
            Compards
compards
            Bool
html
            Bool
filtering
            String
dcfile
            String
selStr
            String -> String
selFun
            (String
prestr, String
poststr)
            GQtyArgs
lineNmb
            GWritingSystemPRPLX
writingSystem
            [(Char, Char)]
allophones
            CharPhoneticClassification
arrCharClassification
            SegmentRulesG
segmentRules
            String
basicSpaces
            String
additionalDelims
            [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h
            GQtyArgs
numTest
            HashCorrections
hc
            (Int8
grps, [Int8]
mxms)
            GQtyArgs
hashStep
            Bool
emptyline
            Int8
splitting
            (String
filesave, GQtyArgs
codesave)
            Bool
concurrently
            String
basiclineoption
            [GQtyArgs]
lineNumbersSel
            [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", String
"+ln", String
"+nm"] ([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)
    , (String
"+P", 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 ::
    -- | 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) ->
    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
. (Char -> Char) -> String -> String
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Char -> Char
forall a. a -> a
id (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
x a -> [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 ->
    -- | Whether to filter out all groups of \'={digits}\' from the lines.
    Bool ->
    (Int -> Compards -> Int8 -> [Int8] -> String -> a1) ->
    Int ->
    Int ->
    [String] ->
    IO [String]
testsOutput :: forall a1.
(Show a1, Integral a1) =>
Bool
-> GQtyArgs
-> Bool
-> (GQtyArgs -> Compards -> Int8 -> [Int8] -> String -> a1)
-> GQtyArgs
-> GQtyArgs
-> [String]
-> IO [String]
testsOutput Bool
concurrently GQtyArgs
syllN Bool
filtering GQtyArgs -> Compards -> Int8 -> [Int8] -> String -> a1
f GQtyArgs
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) = (String, String) -> (String, String)
forall a. NFData a => a -> a
force ((String, String) -> (String, String))
-> ([String] -> (String, String)) -> [String] -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (GQtyArgs -> Compards -> Int8 -> [Int8] -> String -> a1
f GQtyArgs
ldc ([Word8] -> Compards
C1 []) Int8
q [Int8]
qs)) ([String] -> (String, String)) -> [String] -> (String, String)
forall a b. (a -> b) -> a -> b
$ [String]
universalSet
                mx :: a1
mx = GQtyArgs -> Compards -> Int8 -> [Int8] -> String -> a1
f GQtyArgs
ldc ([Word8] -> Compards
C1 []) 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 
                                            ( String
"\n"
                                                String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` (if Bool
filtering then String -> String
removeChangesOfDurations else String -> String
forall a. a -> a
id) 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` (if Bool
filtering then String -> String
removeChangesOfDurations else String -> String
forall a. a -> a
id) 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 ::
    -- | See the conversion function 'Aftovolio.General.Datatype3.zippedDouble2Word8'. It is easier to obtain the function @f::[[[PhoneticPhenomenonRep]]]->[[Double]]@, and, afterwards, you can use 'zippedDouble2Word8' to transform the main semantic kernel of [(PhoneticPhenomenonRep, Double)] into [(PhoneticPhenomenonRep, Word8)]. For more information, see 'https://hackage.haskell.org/package/aftovolio-0.6.2.0/src/README.md' in the section 'Ability to use your own durations of representations of sounds or phonetic phenomena'.
    ([[[PhoneticPhenomenonRep]]] -> [[Word8]]) ->
    -- | Data used to obtain the phonetic language representation of the text.
    GWritingSystemPRPLX ->
    -- | 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.
    [(Char, Char)] ->
    CharPhoneticClassification ->
    SegmentRulesG ->
    -- | Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
    BasicSpaces ->
    -- | Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
    AdditionalDelimiters ->
    -- | 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 ->
    -- | A value that the different options are compared with. If no command line argument \"+di\" was added, then this is a `C1` applied to the list of positive values normed by 255 (the greatest of which is 255) that the line options are compared with. If null, then the program works without comparison. 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. If \"+di\" command line argument was  provided, then this corresponds to the case of differentiation.
    Compards ->
    [AftovolioGen] ->
    Int ->
    Int8 ->
    -- | A file to be probably added output parts to.
    FilePath ->
    Int ->
    IO ()
outputWithFile :: ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> Compards
-> [AftovolioGen]
-> GQtyArgs
-> Int8
-> String
-> GQtyArgs
-> IO ()
outputWithFile [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims String
selStr Compards
compards [AftovolioGen]
sRepresent GQtyArgs
code Int8
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
&& Int8
grps Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
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
L.null String
selStr
            Bool -> Bool -> Bool
&& ([Word8] -> Bool) -> ([Int8] -> Bool) -> Compards -> Bool
forall a b c d.
DoubleFunc a b c d =>
(a -> c) -> (b -> c) -> d -> c
doubleFunc ([Word8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null :: [Word8] -> Bool) ([Int8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null :: [Int8] -> Bool) Compards
compards
    appendF :: String -> IO ()
appendF = String -> String -> IO ()
appendFile String
fs
    lineOption :: AftovolioGen
lineOption = [AftovolioGen] -> AftovolioGen
forall a. HasCallStack => [a] -> a
head ([AftovolioGen] -> AftovolioGen)
-> ([AftovolioGen] -> [AftovolioGen])
-> [AftovolioGen]
-> AftovolioGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AftovolioGen -> Bool) -> [AftovolioGen] -> [AftovolioGen]
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) ([AftovolioGen] -> AftovolioGen) -> [AftovolioGen] -> AftovolioGen
forall a b. (a -> b) -> a -> b
$ [AftovolioGen]
sRepresent
    textP :: String
textP = (\(S GQtyArgs
_ Integer
_ String
ts) -> String
ts) AftovolioGen
lineOption
    outputS :: String
outputS = AftovolioGen -> GQtyArgs -> String
outputSel AftovolioGen
lineOption GQtyArgs
code
    qqs :: [(String, Word8)]
qqs =
        (String -> [Word8])
-> (String -> [String]) -> Seq Read0 -> [(String, Word8)]
readEq4
            ([[Word8]] -> [Word8]
forall a. Monoid a => [a] -> a
mconcat ([[Word8]] -> [Word8])
-> (String -> [[Word8]]) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PhoneticPhenomenonRep]]] -> [[Word8]]
h ([[[PhoneticPhenomenonRep]]] -> [[Word8]])
-> (String -> [[[PhoneticPhenomenonRep]]]) -> String -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PhoneticPhenomenonRep]]]
createSyllablesPL GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims)
            (([PhoneticPhenomenonRep] -> String)
-> [[PhoneticPhenomenonRep]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((PhoneticPhenomenonRep -> Char)
-> [PhoneticPhenomenonRep] -> String
forall a b. (a -> b) -> [a] -> [b]
map PhoneticPhenomenonRep -> Char
charS) ([[PhoneticPhenomenonRep]] -> [String])
-> (String -> [[PhoneticPhenomenonRep]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PhoneticPhenomenonRep]]] -> [[PhoneticPhenomenonRep]]
forall a. Monoid a => [a] -> a
mconcat ([[[PhoneticPhenomenonRep]]] -> [[PhoneticPhenomenonRep]])
-> (String -> [[[PhoneticPhenomenonRep]]])
-> String
-> [[PhoneticPhenomenonRep]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PhoneticPhenomenonRep]]]
createSyllablesPL GWritingSystemPRPLX
writingSystem [(Char, Char)]
allophones CharPhoneticClassification
arrCharClassification SegmentRulesG
segmentRules String
basicSpaces String
additionalDelims)
            (Seq Read0 -> [(String, Word8)])
-> (String -> Seq Read0) -> String -> [(String, Word8)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Seq Read0
basicSplit (String -> [(String, Word8)]) -> String -> [(String, Word8)]
forall a b. (a -> b) -> a -> b
$
            String
textP
    (String
breaks, [Integer]
rs) = [(String, Word8)] -> (String, [Integer])
showZerosFor2PeriodMusic [(String, Word8)]
qqs