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

module Aftovolio.Ukrainian.IO where

-- hiding (id)

import Aftovolio.General.Datatype3
import Aftovolio.General.Distance
import Aftovolio.Halfsplit
import Aftovolio.Tests
import Aftovolio.Ukrainian.Melodics
import Aftovolio.Ukrainian.ReadDurations
import Aftovolio.Ukrainian.Syllable
import Aftovolio.Ukrainian.SyllableWord8
import Aftovolio.UniquenessPeriodsG
import CaseBi.Arr (getBFst')
import Control.Concurrent.Async (mapConcurrently)
import Control.DeepSeq
import Control.Exception
import Data.Char (isDigit, isSpace, toLower)
import Data.Foldable (mapM_)
import Data.List hiding (foldr, null)
import qualified Data.List as L (null)
import Data.Maybe (fromJust, fromMaybe, isNothing)
import Data.MinMax1
import Data.Ord (Down (..), comparing)
import Data.ReversedScientific
import Data.Tuple (fst, snd)
import GHC.Arr
import GHC.Base
import GHC.Enum (fromEnum)
import GHC.Generics
import GHC.Int (Int8)
import GHC.Num (Integer, Num (..), (*), (+), (-))
import GHC.Real (Integral (..), fromIntegral, quotRem, rem, round, (/), (^))
import GHC.Word
import Numeric (showFFloat)
import qualified Rhythmicity.MarkerSeqs as R
import System.Directory (
    Permissions (..),
    doesFileExist,
    getCurrentDirectory,
    getPermissions,
    readable,
    writable,
 )
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 distance value is quoted by 10 in this power if the next ['Word8'] argument is not empty. The default one is 0. The right 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 ->
    -- | 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 ->
    -- | The file to read the sound representation durations from.
    FilePath ->
    Int ->
    R.HashCorrections ->
    (Int8, [Int8]) ->
    Int ->
    Int ->
    Bool ->
    Int8 ->
    (FilePath, Int) ->
    -- | Whether to run tests concurrently or not. 'True' corresponds to concurrent execution that can speed up the getting results but use more resources.
    Bool ->
    -- | An initial string to be analysed.
    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 :: Int
-> Int
-> Compards
-> Bool
-> Bool
-> String
-> String
-> (String, String)
-> Int
-> String
-> Int
-> HashCorrections
-> (Sound8, [Sound8])
-> Int
-> Int
-> Bool
-> Sound8
-> (String, Int)
-> Bool
-> String
-> [Int]
-> [String]
-> IO [String]
generalF Int
power10 Int
ldc Compards
compards Bool
html Bool
filtering String
dcfile String
selStr (String
prestr, String
poststr) Int
lineNmb String
file Int
numTest HashCorrections
hc (Sound8
grps, [Sound8]
mxms) Int
k Int
hashStep Bool
emptyline Sound8
splitting (String
fs, Int
code) Bool
concurrently String
initstr [Int]
lineNumbersSel universalSet :: [String]
universalSet@(String
_ : String
_ : [String]
_) = do
    syllableDurationsDs <- String -> IO [[[[Sound8]]] -> [[Word8]]]
readSyllableDurations String
file
    let syllN = String -> Int
countSyll String
initstr
        f p
ldc Compards
compards [[[[Sound8]]] -> [[Word8]]]
syllableDurationsDs Sound8
grps [Sound8]
mxms 
            | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
selStr =
                ( if ([Word8] -> Bool) -> ([Sound8] -> 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) ([Sound8] -> 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
. Int
-> HashCorrections -> Sound8 -> [Sound8] -> [Word8] -> [Integer]
forall a.
Ord a =>
Int -> HashCorrections -> Sound8 -> [Sound8] -> [a] -> [Integer]
R.countHashes2G Int
hashStep HashCorrections
hc Sound8
grps [Sound8]
mxms)
                    else
                        (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
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 [Sound8] -> Compards
C2 ([Sound8] -> Compards)
-> ([Word8] -> [Sound8]) -> [Word8] -> Compards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Sound8]
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
. ( if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
file
                                    then case Int
k of
                                        Int
1 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD
                                        Int
2 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD2
                                        Int
3 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD3
                                        Int
4 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD4
                                    else
                                        if [[[[Sound8]]] -> [[Word8]]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[[Sound8]]] -> [[Word8]]]
syllableDurationsDs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k
                                            then [[[[Sound8]]] -> [[Word8]]]
syllableDurationsDs [[[[Sound8]]] -> [[Word8]]] -> Int -> [[[Sound8]]] -> [[Word8]]
forall a. HasCallStack => [a] -> Int -> a
!! (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                            else [[[Sound8]]] -> [[Word8]]
syllableDurationsD2
                              )
                            ([[[Sound8]]] -> [[Word8]])
-> (String -> [[[Sound8]]]) -> String -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Sound8]]]
createSyllablesUkrS
                        )
            | 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
. [Sound8] -> [Sound8] -> [Sound8] -> Int16
forall (t1 :: * -> *) (t2 :: * -> *) (t3 :: * -> *) a.
(Foldable t1, Foldable t2, Foldable t3, Ord a) =>
t3 a -> t1 a -> t2 a -> Int16
diverse2GGL (String -> [Sound8]
selectSounds String
selStr) [Sound8
100, Sound8
101]
                    ([Sound8] -> Int16) -> (String -> [Sound8]) -> String -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Sound8]
convertToProperUkrainianI8
                    (String -> [Sound8]) -> (String -> String) -> String -> [Sound8]
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
'=')
    hSetNewlineMode stdout universalNewlineMode
    if numTest
        >= 0
        && numTest
        <= 179
        && numTest
        /= 1
        && doubleFunc (L.null :: [Word8] -> Bool) (L.null :: [Int8] -> Bool) compards
        then
            testsOutput
                concurrently
                syllN
                filtering
                f
                ldc
                syllableDurationsDs
                numTest
                universalSet
        else
            let lgth = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
universalSet
                sRepresent =
                    (Int -> (Integer, String) -> AftovolioUkr)
-> [Int] -> [(Integer, String)] -> [AftovolioUkr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
k (Integer
x, String
ys) -> Int -> Integer -> String -> AftovolioUkr
S Int
k Integer
x String
ys) [Int
1 ..]
                        ([(Integer, String)] -> [AftovolioUkr])
-> ([String] -> [(Integer, String)]) -> [String] -> [AftovolioUkr]
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 -> (Int
-> Compards
-> [[[[Sound8]]] -> [[Word8]]]
-> Sound8
-> [Sound8]
-> String
-> Integer
forall {p}.
p
-> Compards
-> [[[[Sound8]]] -> [[Word8]]]
-> Sound8
-> [Sound8]
-> String
-> Integer
f Int
ldc Compards
compards [[[[Sound8]]] -> [[Word8]]]
syllableDurationsDs Sound8
grps [Sound8]
mxms String
xss, String
xss))
                        ([String] -> [AftovolioUkr]) -> [String] -> [AftovolioUkr]
forall a b. (a -> b) -> a -> b
$ [String]
universalSet
                strOutput 
                    | [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Int]
lineNumbersSel =
                    [String] -> [String]
forall a. NFData a => a -> a
force
                        ([String] -> [String])
-> ([AftovolioUkr] -> [String]) -> [AftovolioUkr] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
                        (String -> [String])
-> ([AftovolioUkr] -> String) -> [AftovolioUkr] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AftovolioUkr -> Integer)
-> Bool -> String -> Sound8 -> [AftovolioUkr] -> String
forall a b.
(Show a, Eq b) =>
(a -> b) -> Bool -> String -> Sound8 -> [a] -> String
halfsplit1G
                            (\(S Int
_ Integer
y String
_) -> Integer
y)
                            Bool
filtering
                            (if Bool
html then String
"<br>" else String
"")
                            (Sound8 -> Sound8
forall {a}. Integral a => a -> a
jjj Sound8
splitting) ([AftovolioUkr] -> [String]) -> [AftovolioUkr] -> [String]
forall a b. (a -> b) -> a -> b
$
                        [AftovolioUkr]
sRepresent
                    | Bool
otherwise = 
                    [String] -> [String]
forall a. NFData a => a -> a
force 
                        ([String] -> [String])
-> ([AftovolioUkr] -> [String]) -> [AftovolioUkr] -> [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])
-> ([AftovolioUkr] -> [String]) -> [AftovolioUkr] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AftovolioUkr -> String) -> [AftovolioUkr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (S Int
k Integer
_ String
qqs) -> if (Int
k Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
lineNumbersSel Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lgth) then String
qqs else [])
                        ([AftovolioUkr] -> [String]) -> [AftovolioUkr] -> [String]
forall a b. (a -> b) -> a -> b
$ [AftovolioUkr]
sRepresent
             in do
                    if L.null lineNumbersSel then do
                         let lns1 = [String] -> String
unlines [String]
strOutput
                         putStrLn lns1
                         if L.null dcfile
                             then putStr ""
                             else do
                                 exist <- doesFileExist dcfile
                                 if exist
                                     then do
                                         perms <- getPermissions dcfile
                                         if writable perms
                                             then writeFile dcfile lns1
                                             else
                                                 error $
                                                     "Aftovolio.Ukrainian.IO.generalF: File "
                                                         `mappend` dcfile
                                                         `mappend` " is not writable!"
                                     else do
                                         currdir <- getCurrentDirectory
                                         perms <- getPermissions currdir
                                         if writable perms
                                             then writeFile dcfile lns1
                                             else
                                                 error $
                                                     "Aftovolio.Ukrainian.IO.generalF: Directory of the file "
                                                         `mappend` dcfile
                                                         `mappend` " is not writable!"
                         let l1 = [AftovolioUkr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AftovolioUkr]
sRepresent
                         if code == -1
                             then
                                 if lineNmb == -1
                                     then return strOutput
                                     else do
                                         print23 filtering prestr poststr 1 [initstr]
                                         return strOutput
                             else do
                                 print23 filtering prestr poststr 1 [initstr]
                                 parseLineNumber l1 >>= \Int
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
                                                 selStr
                                                 compards
                                                 sRepresent
                                                 file
                                                 syllableDurationsDs
                                                 code
                                                 grps
                                                 k
                                                 fs
                                                 num
                                         else
                                             error
                                                 "Aftovolio.Ukrainian.IO.generalF: The specified file cannot be used for appending the text! Please, specify another file!"
                                     return strOutput
                    else mapM_ putStrLn strOutput >> return 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)
generalF Int
_ Int
_ Compards
_ Bool
_ Bool
_ String
_ String
_ (String, String)
_ Int
_ String
_ Int
_ HashCorrections
_ (Sound8, [Sound8])
_ Int
_ Int
_ Bool
_ Sound8
_ (String, Int)
_ Bool
_ String
_ [Int]
_ [String
u1] = do
    String -> IO ()
putStrLn String
u1
    [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
u1]
generalF Int
_ Int
_ Compards
_ Bool
_ Bool
_ String
_ String
_ (String, String)
_ Int
_ String
_ Int
_ HashCorrections
_ (Sound8, [Sound8])
_ Int
_ Int
_ Bool
_ Sound8
_ (String, Int)
_ Bool
_ String
_ [Int]
_ [String]
_ =
    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."
            ]
     in 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]
strOutput
            [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
strOutput

data AftovolioUkr = S !Int !Integer !String deriving (AftovolioUkr -> AftovolioUkr -> Bool
(AftovolioUkr -> AftovolioUkr -> Bool)
-> (AftovolioUkr -> AftovolioUkr -> Bool) -> Eq AftovolioUkr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AftovolioUkr -> AftovolioUkr -> Bool
== :: AftovolioUkr -> AftovolioUkr -> Bool
$c/= :: AftovolioUkr -> AftovolioUkr -> Bool
/= :: AftovolioUkr -> AftovolioUkr -> Bool
Eq, (forall x. AftovolioUkr -> Rep AftovolioUkr x)
-> (forall x. Rep AftovolioUkr x -> AftovolioUkr)
-> Generic AftovolioUkr
forall x. Rep AftovolioUkr x -> AftovolioUkr
forall x. AftovolioUkr -> Rep AftovolioUkr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AftovolioUkr -> Rep AftovolioUkr x
from :: forall x. AftovolioUkr -> Rep AftovolioUkr x
$cto :: forall x. Rep AftovolioUkr x -> AftovolioUkr
to :: forall x. Rep AftovolioUkr x -> AftovolioUkr
Generic)

instance NFData AftovolioUkr

instance Show AftovolioUkr where
    show :: AftovolioUkr -> String
show (S Int
i Integer
j String
xs) =
        Int -> Integer -> String
showBignum Int
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` Int -> Int -> String
forall a. Show a => Int -> a -> String
showWithSpaces Int
4 Int
i

countSyll :: String -> Int
countSyll :: String -> Int
countSyll String
xs =
    Int
numUnderscoresSyll
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ( Integer -> Int
forall a. Enum a => a -> Int
fromEnum
                (Integer -> Int) -> (String -> Integer) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sound8 -> Integer -> Integer) -> Integer -> [Sound8] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\Sound8
x Integer
y -> if Sound8 -> Bool
isVowel1 Sound8
x then Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 else Integer
y) Integer
0
                ([Sound8] -> Integer) -> (String -> [Sound8]) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Sound8]
convertToProperUkrainianI8 (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$
                String
xs
          )
  where
    numUnderscoresSyll :: Int
numUnderscoresSyll =
        [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
            ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter
                ( \String
xs -> let (String
ys, String
ts) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
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 -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$
            String
xs

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

parseHelp :: [String] -> (String, [String])
parseHelp :: [String] -> (String, [String])
parseHelp [String]
xss
    | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [String]
xss = ([], [])
    | Bool
otherwise = ([String] -> String
unwords [String]
rss, [String]
uss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
qss)
  where
    ([String]
yss, [String]
tss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-b") [String]
xss
    ([String]
uss, [String]
wss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+b") [String]
yss
    [[String]
qss, [String]
rss] = ([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1) [[String]
tss, [String]
wss]

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

-- | 'selectSounds' converts the argument after \"+ul\" command line argument into a list of  Ukrainian sound representations that is used for evaluation of \'uniqueness periods\' properties of the line. Is a modified Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.parsey0Choice from the @phonetic-languages-simplified-examples-array-0.21.0.0@ package.
selectSounds :: String -> FlowSound
selectSounds :: String -> [Sound8]
selectSounds =
    [Sound8] -> [Sound8]
forall {a}. Eq a => [a] -> [a]
f
        ([Sound8] -> [Sound8])
-> (String -> [Sound8]) -> String -> [Sound8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sound8 -> Sound8) -> [Sound8] -> [Sound8]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Sound8 -> Sound8
forall a. a -> a
id
        ([Sound8] -> [Sound8])
-> (String -> [Sound8]) -> String -> [Sound8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sound8 -> Bool) -> [Sound8] -> [Sound8]
forall a. (a -> Bool) -> [a] -> [a]
filter (Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Sound8
101)
        ([Sound8] -> [Sound8])
-> (String -> [Sound8]) -> String -> [Sound8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [Sound8]) -> [String] -> [Sound8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [Sound8]
g
        ([String] -> [Sound8])
-> (String -> [String]) -> String -> [Sound8]
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 -> Char
toLower Char
c)
  where
    g :: String -> [Sound8]
g =
        ([Sound8], Array Int (String, [Sound8])) -> String -> [Sound8]
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst'
            ( [Sound8
101 :: Sound8]
            , (Int, Int) -> [(String, [Sound8])] -> Array Int (String, [Sound8])
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray
                (Int
0, Int
41)
                ( ( String
"1"
                  ,
                      [ Sound8
1
                      , Sound8
2
                      , Sound8
3
                      , Sound8
4
                      , Sound8
5
                      , Sound8
6
                      , Sound8
7
                      , Sound8
8
                      , Sound8
10
                      , Sound8
15
                      , Sound8
17
                      , Sound8
19
                      , Sound8
21
                      , Sound8
23
                      , Sound8
25
                      , Sound8
27
                      , Sound8
28
                      , Sound8
30
                      , Sound8
32
                      , Sound8
34
                      , Sound8
36
                      , Sound8
38
                      , Sound8
39
                      , Sound8
41
                      , Sound8
43
                      , Sound8
45
                      , Sound8
47
                      , Sound8
49
                      , Sound8
50
                      , Sound8
52
                      , Sound8
54
                      , Sound8
66
                      ]
                  )
                    (String, [Sound8]) -> [(String, [Sound8])] -> [(String, [Sound8])]
forall a. a -> [a] -> [a]
: (String
"sr", [Sound8
27, Sound8
28, Sound8
30, Sound8
32, Sound8
34, Sound8
36])
                    (String, [Sound8]) -> [(String, [Sound8])] -> [(String, [Sound8])]
forall a. a -> [a] -> [a]
: (String
"vd", [Sound8
8, Sound8
10, Sound8
15, Sound8
17, Sound8
19, Sound8
21, Sound8
23, Sound8
25])
                    (String, [Sound8]) -> [(String, [Sound8])] -> [(String, [Sound8])]
forall a. a -> [a] -> [a]
: (String
"vs", [Sound8
45, Sound8
47, Sound8
49, Sound8
50, Sound8
43, Sound8
52, Sound8
38, Sound8
66, Sound8
54, Sound8
39, Sound8
41])
                    (String, [Sound8]) -> [(String, [Sound8])] -> [(String, [Sound8])]
forall a. a -> [a] -> [a]
: (String
"vw", [Sound8
1 .. Sound8
6])
                    (String, [Sound8]) -> [(String, [Sound8])] -> [(String, [Sound8])]
forall a. a -> [a] -> [a]
: ((String, Sound8) -> (String, [Sound8]))
-> [(String, Sound8)] -> [(String, [Sound8])]
forall a b. (a -> b) -> [a] -> [b]
map
                        (\(String
k, Sound8
t) -> (String
k, [Sound8
t]))
                        [ (String
"\1072", Sound8
1)
                        , (String
"\1073", Sound8
15)
                        , (String
"\1074", Sound8
36)
                        , (String
"\1075", Sound8
21)
                        , (String
"\1076", Sound8
17)
                        , (String
"\1076\1078", Sound8
23)
                        , (String
"\1076\1079", Sound8
8)
                        , (String
"\1077", Sound8
2)
                        , (String
"\1078", Sound8
10)
                        , (String
"\1079", Sound8
25)
                        , (String
"\1080", Sound8
5)
                        , (String
"\1081", Sound8
27)
                        , (String
"\1082", Sound8
45)
                        , (String
"\1083", Sound8
28)
                        , (String
"\1084", Sound8
30)
                        , (String
"\1085", Sound8
32)
                        , (String
"\1086", Sound8
3)
                        , (String
"\1087", Sound8
47)
                        , (String
"\1088", Sound8
34)
                        , (String
"\1089", Sound8
49)
                        , (String
"\1089\1100", Sound8
54)
                        , (String
"\1090", Sound8
50)
                        , (String
"\1091", Sound8
4)
                        , (String
"\1092", Sound8
43)
                        , (String
"\1093", Sound8
52)
                        , (String
"\1094", Sound8
38)
                        , (String
"\1094\1100", Sound8
66)
                        , (String
"\1095", Sound8
39)
                        , (String
"\1096", Sound8
41)
                        , (String
"\1097", Sound8
55)
                        , (String
"\1100", Sound8
7)
                        , (String
"\1102", Sound8
56)
                        , (String
"\1103", Sound8
57)
                        , (String
"\1108", Sound8
58)
                        , (String
"\1110", Sound8
6)
                        , (String
"\1111", Sound8
59)
                        , (String
"\1169", Sound8
19)
                        , (String
"\8217", Sound8
61)
                        ]
                )
            )
    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

-- | Part of the 'generalF' for processment in case of using tests mode.
testsOutput ::
    (Show a1, Integral a1) =>
    -- | Whether to run tests concurrently or not. 'True' corresponds to concurrent execution that can speed up the getting results but use more resources.
    Bool ->
    Int ->
    -- | Whether to filter out all groups of \'={digits}\' from the lines.
    Bool ->
    (Int -> Compards -> p2 -> Int8 -> [Int8] -> String -> a1) ->
    Int ->
    p2 ->
    Int ->
    [String] ->
    IO [String]
testsOutput :: forall a1 p2.
(Show a1, Integral a1) =>
Bool
-> Int
-> Bool
-> (Int -> Compards -> p2 -> Sound8 -> [Sound8] -> String -> a1)
-> Int
-> p2
-> Int
-> [String]
-> IO [String]
testsOutput Bool
concurrently Int
syllN Bool
filtering Int -> Compards -> p2 -> Sound8 -> [Sound8] -> String -> a1
f Int
ldc p2
syllableDurationsDs Int
numTest [String]
universalSet = do
    String -> IO ()
putStrLn String
"Feet   Val  Stat   Proxim"
    ( if Bool
concurrently
            then ((Sound8, [Sound8]) -> IO String)
-> [(Sound8, [Sound8])] -> IO [String]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently
            else ((Sound8, [Sound8]) -> IO String)
-> [(Sound8, [Sound8])] -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
        )
        ( \(Sound8
q, [Sound8]
qs) ->
            let m :: Int
m = Int -> (Sound8, [Sound8]) -> Int
stat1 Int
syllN (Sound8
q, [Sound8]
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 (Int -> Compards -> p2 -> Sound8 -> [Sound8] -> String -> a1
f Int
ldc ([Word8] -> Compards
C1 []) p2
syllableDurationsDs Sound8
q [Sound8]
qs)) ([String] -> (String, String)) -> [String] -> (String, String)
forall a b. (a -> b) -> a -> b
$
                        [String]
universalSet
                mx :: a1
mx = Int -> Compards -> p2 -> Sound8 -> [Sound8] -> String -> a1
f Int
ldc ([Word8] -> Compards
C1 []) p2
syllableDurationsDs Sound8
q [Sound8]
qs String
max1
                strTest :: String
strTest =
                    ( Int -> String
forall a. Show a => a -> String
show (Sound8 -> Int
forall a. Enum a => a -> Int
fromEnum Sound8
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` Int -> String
forall a. Show a => a -> String
show Int
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 Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
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
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) String
"%"
                        String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` ( if Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
numTest Int
10 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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
        )
        ([(Sound8, [Sound8])] -> IO [String])
-> ([[Sound8]] -> [(Sound8, [Sound8])])
-> [[Sound8]]
-> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sound8] -> [[Sound8]] -> [(Sound8, [Sound8])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Sound8]
sel2 Int
numTest)
        ([[Sound8]] -> IO [String]) -> [[Sound8]] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (Int -> [[Sound8]]
sel Int
numTest)

-- | Part of 'generalF' for processment with a file.
outputWithFile ::
    -- | 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 ->
    [AftovolioUkr] ->
    -- | The file to read the sound representation durations from.
    FilePath ->
    [[[[Sound8]]] -> [[Word8]]] ->
    Int ->
    Int8 ->
    Int ->
    -- | A file to be probably added output parts to.
    FilePath ->
    Int ->
    IO ()
outputWithFile :: String
-> Compards
-> [AftovolioUkr]
-> String
-> [[[[Sound8]]] -> [[Word8]]]
-> Int
-> Sound8
-> Int
-> String
-> Int
-> IO ()
outputWithFile String
selStr Compards
compards [AftovolioUkr]
sRepresent String
file [[[[Sound8]]] -> [[Word8]]]
syllableDurationsDs Int
code Sound8
grps Int
k String
fs Int
num
    | Bool
mBool Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10 Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
19 Bool -> Bool -> Bool
&& Sound8
grps Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
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 Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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) -> ([Sound8] -> 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) ([Sound8] -> 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 :: AftovolioUkr
lineOption = [AftovolioUkr] -> AftovolioUkr
forall a. HasCallStack => [a] -> a
head ([AftovolioUkr] -> AftovolioUkr)
-> ([AftovolioUkr] -> [AftovolioUkr])
-> [AftovolioUkr]
-> AftovolioUkr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AftovolioUkr -> Bool) -> [AftovolioUkr] -> [AftovolioUkr]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(S Int
k Integer
_ String
_) -> Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
num) ([AftovolioUkr] -> AftovolioUkr) -> [AftovolioUkr] -> AftovolioUkr
forall a b. (a -> b) -> a -> b
$ [AftovolioUkr]
sRepresent
    textP :: String
textP = (\(S Int
_ Integer
_ String
ts) -> String
ts) AftovolioUkr
lineOption
    --                 sylls = createSyllablesUkrS textP
    outputS :: String
outputS = AftovolioUkr -> Int -> String
outputSel AftovolioUkr
lineOption Int
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
. ( if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
file
                        then case Int
k of
                            Int
1 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD
                            Int
2 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD2
                            Int
3 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD3
                            Int
4 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD4
                        else
                            if [[[[Sound8]]] -> [[Word8]]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[[Sound8]]] -> [[Word8]]]
syllableDurationsDs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k
                                then [[[[Sound8]]] -> [[Word8]]]
syllableDurationsDs [[[[Sound8]]] -> [[Word8]]] -> Int -> [[[Sound8]]] -> [[Word8]]
forall a. HasCallStack => [a] -> Int -> a
!! (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                else [[[Sound8]]] -> [[Word8]]
syllableDurationsD2
                  )
                ([[[Sound8]]] -> [[Word8]])
-> (String -> [[[Sound8]]]) -> String -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Sound8]]]
createSyllablesUkrS
            )
            (([Sound8] -> String) -> [[Sound8]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [Sound8] -> String
showFS ([[Sound8]] -> [String])
-> (String -> [[Sound8]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[Sound8]]
forall a. Monoid a => [a] -> a
mconcat ([[[Sound8]]] -> [[Sound8]])
-> (String -> [[[Sound8]]]) -> String -> [[Sound8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Sound8]]]
createSyllablesUkrS)
            (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])
R.showZerosFor2PeriodMusic [(String, Word8)]
qqs