{-# OPTIONS_HADDOCK -show-extensions #-}
{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}

-- |
-- Module      :  Phladiprelio.General.General.EmphasisG
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Some functionality for SaaW mode of operation for PhLADiPreLiO.
-- 

module Phladiprelio.General.EmphasisG where

import GHC.Base
import GHC.Num ((+),(-))
import GHC.Real (fromIntegral)
import Text.Show (Show (..))
import Data.Tuple (fst,snd)
import GHC.List 
import Data.List (words)
import Phladiprelio.General.Base
import Phladiprelio.General.Syllables
import GHC.Int
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import Data.Char (toUpper)
import GHC.Arr
import Data.List (scanl',intersperse)
import CaseBi.Arr (getBFst',getBFstL',getBFstLSorted')
import Data.Lists.FLines (newLineEnding)
import Data.Traversable (traverse)
import Control.Applicative
import System.IO (stderr,hPutStr,getLine)

data SyllWeightsG = SyG {
  SyllWeightsG -> [PRS]
point :: ![PRS]
  , SyllWeightsG -> Int8
order :: !Int8 -- Is intended to begin at -128 up to 127 (maximum 256 entries).
  , SyllWeightsG -> Double
weight :: !Double
}

showFSG :: FlowSoundG -> String
showFSG :: [PRS] -> String
showFSG = forall a b. (a -> b) -> [a] -> [b]
map PRS -> Char
charS
{-# INLINE showFSG #-}

type FlowSoundG = [PRS]

instance Show SyllWeightsG where
  show :: SyllWeightsG -> String
show (SyG [PRS]
ps Int8
i Double
w) = [PRS] -> String
showFSG [PRS]
ps forall a. Monoid a => a -> a -> a
`mappend` (Char
' 'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int8
i) forall a. Monoid a => a -> a -> a
`mappend` (Char
' 'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Double
w) forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding

weightSyllablesIO :: [FlowSoundG] -> IO [SyllWeightsG]
weightSyllablesIO :: [[PRS]] -> IO [SyllWeightsG]
weightSyllablesIO = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Int8
i,[PRS]
xs) -> (\Double
d1 -> ([PRS] -> Int8 -> Double -> SyllWeightsG
SyG [PRS]
xs Int8
i Double
d1)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [PRS] -> IO Double
weightSyllAIO Bool
False [PRS]
xs)  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip ([-Int8
128..Int8
127]::[Int8])

weightStringIO 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> IO ([[FlowSoundG]],[SyllWeightsG],[[[Int8]]])
weightStringIO :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> IO ([[[PRS]]], [SyllWeightsG], [[[Int8]]])
weightStringIO GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
xs = [[PRS]] -> IO [SyllWeightsG]
weightSyllablesIO [[PRS]]
fss forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[SyllWeightsG]
zs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[[PRS]]]
tsss, [SyllWeightsG]
zs, [Int8] -> [[[Int8]]]
helper1F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' forall a. Num a => a -> a -> a
(+) (-Int8
128::Int8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Int
length) forall a b. (a -> b) -> a -> b
$ [[[PRS]]]
tsss)
  where tsss :: [[[PRS]]]
tsss = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
xs
        fss :: [[PRS]]
fss = [ [PRS]
ts | [[PRS]]
tss <- [[[PRS]]]
tsss , [PRS]
ts <- [[PRS]]
tss ]

weightStringNIO 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> Int 
  ->  String 
  -> IO ([[FlowSoundG]],[[SyllWeightsG]],[[[Int8]]])
weightStringNIO :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Int
-> String
-> IO ([[[PRS]]], [[SyllWeightsG]], [[[Int8]]])
weightStringNIO GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs Int
n String
xs = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
_-> [[PRS]] -> IO [SyllWeightsG]
weightSyllablesIO [[PRS]]
fss) [Int
1..Int
n] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[[SyllWeightsG]]
zss -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[[PRS]]]
tsss, [[SyllWeightsG]]
zss, [Int8] -> [[[Int8]]]
helper1F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' forall a. Num a => a -> a -> a
(+) (-Int8
128::Int8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Int
length) forall a b. (a -> b) -> a -> b
$ [[[PRS]]]
tsss)
  where tsss :: [[[PRS]]]
tsss = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
xs
        fss :: [[PRS]]
fss = [ [PRS]
ts | [[PRS]]
tss <- [[[PRS]]]
tsss , [PRS]
ts <- [[PRS]]
tss ]

weights2SyllableDurationsDArr :: [SyllWeightsG] -> Array Int (Int8,Double)
weights2SyllableDurationsDArr :: [SyllWeightsG] -> Array Int (Int8, Double)
weights2SyllableDurationsDArr [SyllWeightsG]
xs = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
lforall a. Num a => a -> a -> a
-Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(SyG [PRS]
_ Int8
i Double
w) -> (Int8
i,Double
w)) forall a b. (a -> b) -> a -> b
$ [SyllWeightsG]
xs
  where l :: Int
l = forall a. [a] -> Int
length [SyllWeightsG]
xs

weights2SyllableDurationsD :: [SyllWeightsG] -> [[[Int8]]] -> [[Double]]
weights2SyllableDurationsD :: [SyllWeightsG] -> [[[Int8]]] -> [[Double]]
weights2SyllableDurationsD [SyllWeightsG]
xs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall {b} {t}. Num b => (t -> b) -> [t] -> b
k (forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Double
4.0, [SyllWeightsG] -> Array Int (Int8, Double)
weights2SyllableDurationsDArr [SyllWeightsG]
xs))))
  where k :: (t -> b) -> [t] -> b
k t -> b
f = forall a b. (b -> a -> b) -> b -> [a] -> b
foldl' (\b
y t
x -> t -> b
f t
x forall a. Num a => a -> a -> a
+ b
y) b
0
{-# INLINE weights2SyllableDurationsD #-}

helper1F :: [Int8] -> [[[Int8]]]
helper1F :: [Int8] -> [[[Int8]]]
helper1F (Int8
x:Int8
y:[Int8]
ys) = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[]) [Int8
x..Int8
yforall a. Num a => a -> a -> a
-Int8
1]forall a. a -> [a] -> [a]
:[Int8] -> [[[Int8]]]
helper1F (Int8
yforall a. a -> [a] -> [a]
:[Int8]
ys)
helper1F [Int8]
_ = []

weightSyllAIO :: Bool -> FlowSoundG -> IO Double
weightSyllAIO :: Bool -> [PRS] -> IO Double
weightSyllAIO Bool
upper [PRS]
xs
  | forall a. [a] -> Bool
null [PRS]
xs = forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
4.0
  | Bool
otherwise = 
    (\String
d -> forall a. a -> Maybe a -> a
fromMaybe Double
4.0 (forall a. Read a => String -> Maybe a
readMaybe String
d::Maybe Double)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Handle -> String -> IO ()
hPutStr Handle
stderr (String
"?  " forall a. Monoid a => a -> a -> a
`mappend` ((if Bool
upper then forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PRS] -> String
showFSG forall a b. (a -> b) -> a -> b
$ [PRS]
xs) forall a. Monoid a => a -> a -> a
`mappend` String
"   ") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO String
getLine) -- Well, definitely it should not be 'stderr' here, but 'stdout' gives some strange behaviour, probably related to optimizations or some strange 'Handle' behaviour. (?)


data ReadyForConstructionPL = StrG String | FSLG [[[Int8]]] deriving (ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
$c/= :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
== :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
$c== :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
Eq,Eq ReadyForConstructionPL
ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
ReadyForConstructionPL -> ReadyForConstructionPL -> Ordering
ReadyForConstructionPL
-> ReadyForConstructionPL -> ReadyForConstructionPL
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReadyForConstructionPL
-> ReadyForConstructionPL -> ReadyForConstructionPL
$cmin :: ReadyForConstructionPL
-> ReadyForConstructionPL -> ReadyForConstructionPL
max :: ReadyForConstructionPL
-> ReadyForConstructionPL -> ReadyForConstructionPL
$cmax :: ReadyForConstructionPL
-> ReadyForConstructionPL -> ReadyForConstructionPL
>= :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
$c>= :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
> :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
$c> :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
<= :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
$c<= :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
< :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
$c< :: ReadyForConstructionPL -> ReadyForConstructionPL -> Bool
compare :: ReadyForConstructionPL -> ReadyForConstructionPL -> Ordering
$ccompare :: ReadyForConstructionPL -> ReadyForConstructionPL -> Ordering
Ord)

showR :: ReadyForConstructionPL -> String
showR :: ReadyForConstructionPL -> String
showR (StrG String
xs) = String
xs
showR (FSLG [[[Int8]]]
tsss) = forall a. Show a => a -> String
show [[[Int8]]]
tsss

isStr :: ReadyForConstructionPL -> Bool
isStr :: ReadyForConstructionPL -> Bool
isStr (StrG String
_) = Bool
True
isStr ReadyForConstructionPL
_ = Bool
False

isFSL :: ReadyForConstructionPL -> Bool
isFSL :: ReadyForConstructionPL -> Bool
isFSL (FSLG [[[Int8]]]
_) = Bool
True
isFSL ReadyForConstructionPL
_ = Bool
False

fromReadyFCPLS :: ReadyForConstructionPL -> Maybe String
fromReadyFCPLS :: ReadyForConstructionPL -> Maybe String
fromReadyFCPLS (StrG String
xs) = forall a. a -> Maybe a
Just String
xs
fromReadyFCPLS ReadyForConstructionPL
_ = forall a. Maybe a
Nothing

fromReadyFCPLF :: ReadyForConstructionPL -> Maybe [[[Int8]]]
fromReadyFCPLF :: ReadyForConstructionPL -> Maybe [[[Int8]]]
fromReadyFCPLF (FSLG [[[Int8]]]
xsss) = forall a. a -> Maybe a
Just [[[Int8]]]
xsss
fromReadyFCPLF ReadyForConstructionPL
_ = forall a. Maybe a
Nothing

helper2F :: [b] -> [a] -> [c] -> [[d]] -> [([b],[a],[c])]
helper2F :: forall b a c d. [b] -> [a] -> [c] -> [[d]] -> [([b], [a], [c])]
helper2F [b]
vs [a]
xs [c]
ys [[d]]
tss = let ([b]
us,[a]
ks,[c]
rs) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [b]
vs [a]
xs forall a b. (a -> b) -> a -> b
$ [c]
ys in
  forall b a c d. [b] -> [a] -> [c] -> [[d]] -> [([b], [a], [c])]
helper2F' [b]
us [a]
ks [c]
rs [[d]]
tss
    where helper2F' :: [a] -> [a] -> [a] -> [[a]] -> [([a], [a], [a])]
helper2F' us :: [a]
us@(a
_:[a]
_) ks :: [a]
ks@(a
_:[a]
_) rs :: [a]
rs@(a
_:[a]
_) tss :: [[a]]
tss@([a]
ts:[[a]]
wss) =
            let l :: Int
l = forall a. [a] -> Int
length [a]
ts
                ([a]
wws,[a]
vvs) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
l [a]
us
                ([a]
qs,[a]
ps) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
l [a]
ks
                ([a]
ns,[a]
ms) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
l [a]
rs
                in ([a]
wws,[a]
qs,[a]
ns)forall a. a -> [a] -> [a]
:[a] -> [a] -> [a] -> [[a]] -> [([a], [a], [a])]
helper2F' [a]
vvs [a]
ps [a]
ms [[a]]
wss
          helper2F' [a]
_ [a]
_ [a]
_ [[a]]
_ = []
 
convF1 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> [[FlowSoundG]]
convF1 :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
convF1 GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
xs
 | forall a. [a] -> Bool
null String
xs = []
 | Bool
otherwise = [ [[PRS]]
tss | [[PRS]]
tss <- GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
xs ]

convF3 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> [([String],[[Int8]],[FlowSoundG])]
convF3 :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [([String], [[Int8]], [[PRS]])]
convF3 GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
xs
 | forall a. [a] -> Bool
null String
xs = [([],[],[])]
 | Bool
otherwise = forall b a c d. [b] -> [a] -> [c] -> [[d]] -> [([b], [a], [c])]
helper2F (forall a b. (a -> [b]) -> [a] -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map [PRS] -> String
showFSG) [[[PRS]]]
tsss) (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[]) ([-Int8
128..Int8
127]::[Int8])) [ [PRS]
ts | [[PRS]]
tss <- [[[PRS]]]
qss, [PRS]
ts <- [[PRS]]
tss ] [[[PRS]]]
qss
    where tsss :: [[[PRS]]]
tsss = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
xs
          qss :: [[[PRS]]]
qss = [ [[PRS]]
tss | [[PRS]]
tss <- [[[PRS]]]
tsss ]

convF3W 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> [(String,[[Int8]])]
convF3W :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [(String, [[Int8]])]
convF3W GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
xs
 | forall a. [a] -> Bool
null String
xs = [([],[])]
 | Bool
otherwise = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\([String]
_,[[Int8]]
ys,[[PRS]]
_) String
ts -> (String
ts,[[Int8]]
ys)) (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [([String], [[Int8]], [[PRS]])]
convF3 GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
xs

convFI 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> String 
  -> [[[Int8]]]
convFI :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> String
-> [[[Int8]]]
convFI GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts = forall a b. (a -> b) -> [a] -> [b]
map String -> [[Int8]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
  where !f :: String -> [[Int8]]
f = forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' [] (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [(String, [[Int8]])]
convF3W GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts)

convFSL 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> ReadyForConstructionPL 
  -> String
convFSL :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> ReadyForConstructionPL
-> String
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ps CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts r :: ReadyForConstructionPL
r@(StrG String
xs) = forall a. [[a]] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [String
" "] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\([String]
ks,[[Int8]]
_,[[PRS]]
_)-> [String]
ks) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [([String], [[Int8]], [[PRS]])]
convF3 GWritingSystemPRPLX
wrs [(Char, Char)]
ps CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs forall a b. (a -> b) -> a -> b
$ String
xs
   where js :: ([[[Int8]]], [[String]])
js =  forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\([String]
rs,[[Int8]]
ps,[[PRS]]
_) -> ([[Int8]]
ps,[String]
rs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [([String], [[Int8]], [[PRS]])]
convF3 GWritingSystemPRPLX
wrs [(Char, Char)]
ps CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs forall a b. (a -> b) -> a -> b
$ String
ts
convFSL GWritingSystemPRPLX
wrs [(Char, Char)]
ps CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts r :: ReadyForConstructionPL
r@(FSLG [[[Int8]]]
tsss) =  forall a. [[a]] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [String
" "] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' String
" " [([Int8], String)]
ks) ) forall a b. (a -> b) -> a -> b
$ [[[Int8]]]
tsss
   where js :: ([[[Int8]]], [[String]])
js = forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\([String]
rs,[[Int8]]
ps,[[PRS]]
_) -> ([[Int8]]
ps,[String]
rs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [([String], [[Int8]], [[PRS]])]
convF3 GWritingSystemPRPLX
wrs [(Char, Char)]
ps CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs forall a b. (a -> b) -> a -> b
$ String
ts
         ks :: [([Int8], String)]
ks = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [[a]] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ ([[[Int8]]], [[String]])
js) (forall a. [[a]] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ ([[[Int8]]], [[String]])
js)

weightsString3IO 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> Bool 
  -> String 
  -> IO ([[FlowSoundG]],[[[[Int8]]] -> [[Double]]],ReadyForConstructionPL)
weightsString3IO :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Bool
-> String
-> IO
     ([[[PRS]]], [[[[Int8]]] -> [[Double]]], ReadyForConstructionPL)
weightsString3IO GWritingSystemPRPLX
wrs [(Char, Char)]
ps CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs Bool
bool String
bs 
 | Bool
bool = do
   ([[[PRS]]]
syllDs1,[SyllWeightsG]
sylws,[[[Int8]]]
fsls0) <- GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> IO ([[[PRS]]], [SyllWeightsG], [[[Int8]]])
weightStringIO GWritingSystemPRPLX
wrs [(Char, Char)]
ps CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
bs
   let syllableDurationsD2s :: [[[[Int8]]] -> [[Double]]]
syllableDurationsD2s = [[SyllWeightsG] -> [[[Int8]]] -> [[Double]]
weights2SyllableDurationsD [SyllWeightsG]
sylws]
   forall (m :: * -> *) a. Monad m => a -> m a
return ([[[PRS]]]
syllDs1,[[[[Int8]]] -> [[Double]]]
syllableDurationsD2s,[[[Int8]]] -> ReadyForConstructionPL
FSLG [[[Int8]]]
fsls0) 
 | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],[[[Int8]]] -> ReadyForConstructionPL
FSLG [])

weightsString3NIO 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> Int 
  -> Bool 
  -> String 
  -> IO ([[FlowSoundG]],[[[[Int8]]] -> [[Double]]],ReadyForConstructionPL)
weightsString3NIO :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Int
-> Bool
-> String
-> IO
     ([[[PRS]]], [[[[Int8]]] -> [[Double]]], ReadyForConstructionPL)
weightsString3NIO GWritingSystemPRPLX
wrs [(Char, Char)]
ps CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs Int
n Bool
bool String
bs 
 | Bool
bool = (\([[[PRS]]]
syllDs1,[[SyllWeightsG]]
sylws,[[[Int8]]]
fsls0) -> ([[[PRS]]]
syllDs1,forall a b. (a -> b) -> [a] -> [b]
map [SyllWeightsG] -> [[[Int8]]] -> [[Double]]
weights2SyllableDurationsD [[SyllWeightsG]]
sylws,[[[Int8]]] -> ReadyForConstructionPL
FSLG [[[Int8]]]
fsls0)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Int
-> String
-> IO ([[[PRS]]], [[SyllWeightsG]], [[[Int8]]])
weightStringNIO GWritingSystemPRPLX
wrs [(Char, Char)]
ps CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs Int
n String
bs
 | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([],[],[[[Int8]]] -> ReadyForConstructionPL
FSLG [])