{-# LANGUAGE BangPatterns #-}



module Phonetic.Languages.Emphasis where

import Languages.Phonetic.Ukrainian.Syllable.ArrInt8
import Melodics.Ukrainian.ArrInt8
import Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 (syllableDurationsGD)
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
import CaseBi.Arr (getBFst',getBFstLSorted')
import Data.Lists.FLines (newLineEnding)
import Data.Traversable (traverse)
import Control.Applicative
import System.IO

data SyllWeights = Sy {
  SyllWeights -> FlowSound
point :: !FlowSound
  , SyllWeights -> Int8
order :: !Int8 -- Is intended to begin at -128 up to 0 (maximum 129 entries).
  , SyllWeights -> Double
weight :: !Double
}

instance Show SyllWeights where
  show :: SyllWeights -> String
show (Sy FlowSound
ps Int8
i Double
w) = FlowSound -> String
showFS FlowSound
ps String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:Int8 -> String
forall a. Show a => a -> String
show Int8
i) String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:Double -> String
forall a. Show a => a -> String
show Double
w) String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding

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

weightStringIO :: String -> IO ([[FlowSound]],[SyllWeights],[[FlowSound]])
weightStringIO :: String -> IO ([[FlowSound]], [SyllWeights], [[FlowSound]])
weightStringIO String
xs = [FlowSound] -> IO [SyllWeights]
weightSyllablesIO [FlowSound]
fss IO [SyllWeights]
-> ([SyllWeights]
    -> IO ([[FlowSound]], [SyllWeights], [[FlowSound]]))
-> IO ([[FlowSound]], [SyllWeights], [[FlowSound]])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[SyllWeights]
zs -> ([[FlowSound]], [SyllWeights], [[FlowSound]])
-> IO ([[FlowSound]], [SyllWeights], [[FlowSound]])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[FlowSound]]
tsss, [SyllWeights]
zs, FlowSound -> [[FlowSound]]
helper1F (FlowSound -> [[FlowSound]])
-> ([[FlowSound]] -> FlowSound) -> [[FlowSound]] -> [[FlowSound]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Int8 -> Int8) -> Int8 -> FlowSound -> FlowSound
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
(+) (-Int8
128::Int8) (FlowSound -> FlowSound)
-> ([[FlowSound]] -> FlowSound) -> [[FlowSound]] -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FlowSound] -> Int8) -> [[FlowSound]] -> FlowSound
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int8) -> ([FlowSound] -> Int) -> [FlowSound] -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FlowSound] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[FlowSound]] -> [[FlowSound]]) -> [[FlowSound]] -> [[FlowSound]]
forall a b. (a -> b) -> a -> b
$ [[FlowSound]]
tsss)
  where tsss :: [[FlowSound]]
tsss = String -> [[FlowSound]]
createSyllablesUkrS String
xs
        fss :: [FlowSound]
fss = [ FlowSound
ts | [FlowSound]
tss <- [[FlowSound]]
tsss , FlowSound
ts <- [FlowSound]
tss ]

weightStringNIO :: Int ->  String -> IO ([[FlowSound]],[[SyllWeights]],[[FlowSound]])
weightStringNIO :: Int -> String -> IO ([[FlowSound]], [[SyllWeights]], [[FlowSound]])
weightStringNIO Int
n String
xs = (Int -> IO [SyllWeights]) -> [Int] -> IO [[SyllWeights]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
_-> [FlowSound] -> IO [SyllWeights]
weightSyllablesIO [FlowSound]
fss) [Int
1..Int
n] IO [[SyllWeights]]
-> ([[SyllWeights]]
    -> IO ([[FlowSound]], [[SyllWeights]], [[FlowSound]]))
-> IO ([[FlowSound]], [[SyllWeights]], [[FlowSound]])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[[SyllWeights]]
zss -> ([[FlowSound]], [[SyllWeights]], [[FlowSound]])
-> IO ([[FlowSound]], [[SyllWeights]], [[FlowSound]])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[FlowSound]]
tsss, [[SyllWeights]]
zss, FlowSound -> [[FlowSound]]
helper1F (FlowSound -> [[FlowSound]])
-> ([[FlowSound]] -> FlowSound) -> [[FlowSound]] -> [[FlowSound]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Int8 -> Int8) -> Int8 -> FlowSound -> FlowSound
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
(+) (-Int8
128::Int8) (FlowSound -> FlowSound)
-> ([[FlowSound]] -> FlowSound) -> [[FlowSound]] -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FlowSound] -> Int8) -> [[FlowSound]] -> FlowSound
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int8) -> ([FlowSound] -> Int) -> [FlowSound] -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FlowSound] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[FlowSound]] -> [[FlowSound]]) -> [[FlowSound]] -> [[FlowSound]]
forall a b. (a -> b) -> a -> b
$ [[FlowSound]]
tsss)
  where tsss :: [[FlowSound]]
tsss = String -> [[FlowSound]]
createSyllablesUkrS String
xs
        fss :: [FlowSound]
fss = [ FlowSound
ts | [FlowSound]
tss <- [[FlowSound]]
tsss , FlowSound
ts <- [FlowSound]
tss ]

weights2SyllableDurationsDArr :: [SyllWeights] -> Array Int (Sound8,Double)
weights2SyllableDurationsDArr :: [SyllWeights] -> Array Int (Int8, Double)
weights2SyllableDurationsDArr [SyllWeights]
xs = (Int, Int) -> [(Int8, Double)] -> Array Int (Int8, Double)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([(Int8, Double)] -> Array Int (Int8, Double))
-> ([SyllWeights] -> [(Int8, Double)])
-> [SyllWeights]
-> Array Int (Int8, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SyllWeights -> (Int8, Double))
-> [SyllWeights] -> [(Int8, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Sy FlowSound
_ Int8
i Double
w) -> (Int8
i,Double
w)) ([SyllWeights] -> Array Int (Int8, Double))
-> [SyllWeights] -> Array Int (Int8, Double)
forall a b. (a -> b) -> a -> b
$ [SyllWeights]
xs
  where l :: Int
l = [SyllWeights] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SyllWeights]
xs

weights2SyllableDurationsD :: [SyllWeights] -> [[[Sound8]]] -> [[Double]]
weights2SyllableDurationsD :: [SyllWeights] -> [[FlowSound]] -> [[Double]]
weights2SyllableDurationsD [SyllWeights]
xs = (Int8 -> Double) -> [[FlowSound]] -> [[Double]]
syllableDurationsGD ((Double, Array Int (Int8, Double)) -> Int8 -> Double
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Double
4.0, [SyllWeights] -> Array Int (Int8, Double)
weights2SyllableDurationsDArr [SyllWeights]
xs))
{-# INLINE weights2SyllableDurationsD #-}

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

weightSyllAIO :: Bool -> FlowSound -> IO Double
weightSyllAIO :: Bool -> FlowSound -> IO Double
weightSyllAIO Bool
upper FlowSound
xs
  | FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
xs = Double -> IO Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
4.0
  | Bool
otherwise = 
    (\String
d -> Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
4.0 (String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
d::Maybe Double)) (String -> Double) -> IO String -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Handle -> String -> IO ()
hPutStr Handle
stderr (String
"?  " String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` ((if Bool
upper then (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper else ShowS
forall a. a -> a
id) ShowS -> (FlowSound -> String) -> FlowSound -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> String
showFS (FlowSound -> String) -> FlowSound -> String
forall a b. (a -> b) -> a -> b
$ FlowSound
xs) String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` String
"   ") IO () -> IO String -> IO 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 ReadyForConstructionUkr = Str String | FSL [[FlowSound]] deriving (ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
(ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool)
-> (ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool)
-> Eq ReadyForConstructionUkr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
$c/= :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
== :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
$c== :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
Eq,Eq ReadyForConstructionUkr
Eq ReadyForConstructionUkr
-> (ReadyForConstructionUkr -> ReadyForConstructionUkr -> Ordering)
-> (ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool)
-> (ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool)
-> (ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool)
-> (ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool)
-> (ReadyForConstructionUkr
    -> ReadyForConstructionUkr -> ReadyForConstructionUkr)
-> (ReadyForConstructionUkr
    -> ReadyForConstructionUkr -> ReadyForConstructionUkr)
-> Ord ReadyForConstructionUkr
ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
ReadyForConstructionUkr -> ReadyForConstructionUkr -> Ordering
ReadyForConstructionUkr
-> ReadyForConstructionUkr -> ReadyForConstructionUkr
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 :: ReadyForConstructionUkr
-> ReadyForConstructionUkr -> ReadyForConstructionUkr
$cmin :: ReadyForConstructionUkr
-> ReadyForConstructionUkr -> ReadyForConstructionUkr
max :: ReadyForConstructionUkr
-> ReadyForConstructionUkr -> ReadyForConstructionUkr
$cmax :: ReadyForConstructionUkr
-> ReadyForConstructionUkr -> ReadyForConstructionUkr
>= :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
$c>= :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
> :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
$c> :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
<= :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
$c<= :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
< :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
$c< :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
compare :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Ordering
$ccompare :: ReadyForConstructionUkr -> ReadyForConstructionUkr -> Ordering
$cp1Ord :: Eq ReadyForConstructionUkr
Ord)

showR :: ReadyForConstructionUkr -> String
showR :: ReadyForConstructionUkr -> String
showR (Str String
xs) = String
xs
showR (FSL [[FlowSound]]
tsss) = [[FlowSound]] -> String
forall a. Show a => a -> String
show [[FlowSound]]
tsss

isStr :: ReadyForConstructionUkr -> Bool
isStr :: ReadyForConstructionUkr -> Bool
isStr (Str String
_) = Bool
True
isStr ReadyForConstructionUkr
_ = Bool
False

isFSL :: ReadyForConstructionUkr -> Bool
isFSL :: ReadyForConstructionUkr -> Bool
isFSL (FSL [[FlowSound]]
_) = Bool
True
isFSL ReadyForConstructionUkr
_ = Bool
False

fromReadyFCUkrS :: ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS :: ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS (Str String
xs) = String -> Maybe String
forall a. a -> Maybe a
Just String
xs
fromReadyFCUkrS ReadyForConstructionUkr
_ = Maybe String
forall a. Maybe a
Nothing

fromReadyFCUkrF :: ReadyForConstructionUkr -> Maybe [[FlowSound]]
fromReadyFCUkrF :: ReadyForConstructionUkr -> Maybe [[FlowSound]]
fromReadyFCUkrF (FSL [[FlowSound]]
xsss) = [[FlowSound]] -> Maybe [[FlowSound]]
forall a. a -> Maybe a
Just [[FlowSound]]
xsss
fromReadyFCUkrF ReadyForConstructionUkr
_ = Maybe [[FlowSound]]
forall a. Maybe a
Nothing

helper2F :: [b] -> [a] -> [a] -> [[a]] -> [([b],[a],[a])]
helper2F :: [b] -> [a] -> [a] -> [[a]] -> [([b], [a], [a])]
helper2F [b]
vs [a]
xs [a]
ys [[a]]
tss = let ([b]
us,[a]
ks,[a]
rs) = [(b, a, a)] -> ([b], [a], [a])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(b, a, a)] -> ([b], [a], [a]))
-> ([a] -> [(b, a, a)]) -> [a] -> ([b], [a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> [a] -> [a] -> [(b, a, a)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [b]
vs [a]
xs ([a] -> ([b], [a], [a])) -> [a] -> ([b], [a], [a])
forall a b. (a -> b) -> a -> b
$ [a]
ys in
  [b] -> [a] -> [a] -> [[a]] -> [([b], [a], [a])]
forall (t :: * -> *) a a a a.
Foldable t =>
[a] -> [a] -> [a] -> [t a] -> [([a], [a], [a])]
helper2F' [b]
us [a]
ks [a]
rs [[a]]
tss
    where helper2F' :: [a] -> [a] -> [a] -> [t a] -> [([a], [a], [a])]
helper2F' us :: [a]
us@(a
_:[a]
_) ks :: [a]
ks@(a
_:[a]
_) rs :: [a]
rs@(a
_:[a]
_) tss :: [t a]
tss@(t a
ts:[t a]
wss) =
            let l :: Int
l = t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ts
                ([a]
wws,[a]
vvs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
l [a]
us
                ([a]
qs,[a]
ps) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
l [a]
ks
                ([a]
ns,[a]
ms) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
l [a]
rs
                in ([a]
wws,[a]
qs,[a]
ns)([a], [a], [a]) -> [([a], [a], [a])] -> [([a], [a], [a])]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a] -> [t a] -> [([a], [a], [a])]
helper2F' [a]
vvs [a]
ps [a]
ms [t a]
wss
          helper2F' [a]
_ [a]
_ [a]
_ [t a]
_ = []
 
convF1 :: String -> [[FlowSound]]
convF1 :: String -> [[FlowSound]]
convF1 String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = []
 | Bool
otherwise = [ [FlowSound]
tss | [FlowSound]
tss <- String -> [[FlowSound]]
createSyllablesUkrS String
xs ]

convF3 :: String -> [([String],[FlowSound],[FlowSound])]
convF3 :: String -> [([String], [FlowSound], [FlowSound])]
convF3 String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = [([],[],[])]
 | Bool
otherwise = [String]
-> [FlowSound]
-> [FlowSound]
-> [[FlowSound]]
-> [([String], [FlowSound], [FlowSound])]
forall b a. [b] -> [a] -> [a] -> [[a]] -> [([b], [a], [a])]
helper2F (([FlowSound] -> [String]) -> [[FlowSound]] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((FlowSound -> String) -> [FlowSound] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FlowSound -> String
showFS) [[FlowSound]]
tsss) ((Int8 -> FlowSound) -> FlowSound -> [FlowSound]
forall a b. (a -> b) -> [a] -> [b]
map (Int8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:[]) ([-Int8
128..Int8
0]::[Int8])) [ FlowSound
ts | [FlowSound]
tss <- [[FlowSound]]
qss, FlowSound
ts <- [FlowSound]
tss ] [[FlowSound]]
qss
    where tsss :: [[FlowSound]]
tsss = String -> [[FlowSound]]
createSyllablesUkrS String
xs
          qss :: [[FlowSound]]
qss = [ [FlowSound]
tss | [FlowSound]
tss <- [[FlowSound]]
tsss ]

convF3W :: String -> [(String,[FlowSound])]
convF3W :: String -> [(String, [FlowSound])]
convF3W String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = [([],[])]
 | Bool
otherwise = (([String], [FlowSound], [FlowSound])
 -> String -> (String, [FlowSound]))
-> [([String], [FlowSound], [FlowSound])]
-> [String]
-> [(String, [FlowSound])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\([String]
_,[FlowSound]
ys,[FlowSound]
_) String
ts -> (String
ts,[FlowSound]
ys)) (String -> [([String], [FlowSound], [FlowSound])]
convF3 String
xs) ([String] -> [(String, [FlowSound])])
-> (String -> [String]) -> String -> [(String, [FlowSound])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [(String, [FlowSound])])
-> String -> [(String, [FlowSound])]
forall a b. (a -> b) -> a -> b
$ String
xs

convFI :: String -> String -> [[FlowSound]]
convFI :: String -> String -> [[FlowSound]]
convFI String
ts = (String -> [FlowSound]) -> [String] -> [[FlowSound]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [FlowSound]
f ([String] -> [[FlowSound]])
-> (String -> [String]) -> String -> [[FlowSound]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
  where !f :: String -> [FlowSound]
f = [FlowSound] -> [(String, [FlowSound])] -> String -> [FlowSound]
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' [] (String -> [(String, [FlowSound])]
convF3W String
ts)

convFSL :: String -> ReadyForConstructionUkr -> String
convFSL :: String -> ReadyForConstructionUkr -> String
convFSL String
ts r :: ReadyForConstructionUkr
r@(Str String
xs) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
intersperse [String
" "] ([[String]] -> [[String]])
-> (String -> [[String]]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], [FlowSound], [FlowSound]) -> [String])
-> [([String], [FlowSound], [FlowSound])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (\([String]
ks,[FlowSound]
_,[FlowSound]
_)-> [String]
ks) ([([String], [FlowSound], [FlowSound])] -> [[String]])
-> (String -> [([String], [FlowSound], [FlowSound])])
-> String
-> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [([String], [FlowSound], [FlowSound])]
convF3 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
xs
   where js :: ([[FlowSound]], [[String]])
js =  [([FlowSound], [String])] -> ([[FlowSound]], [[String]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([FlowSound], [String])] -> ([[FlowSound]], [[String]]))
-> (String -> [([FlowSound], [String])])
-> String
-> ([[FlowSound]], [[String]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], [FlowSound], [FlowSound]) -> ([FlowSound], [String]))
-> [([String], [FlowSound], [FlowSound])]
-> [([FlowSound], [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\([String]
rs,[FlowSound]
ps,[FlowSound]
_) -> ([FlowSound]
ps,[String]
rs)) ([([String], [FlowSound], [FlowSound])]
 -> [([FlowSound], [String])])
-> (String -> [([String], [FlowSound], [FlowSound])])
-> String
-> [([FlowSound], [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [([String], [FlowSound], [FlowSound])]
convF3 (String -> ([[FlowSound]], [[String]]))
-> String -> ([[FlowSound]], [[String]])
forall a b. (a -> b) -> a -> b
$ String
ts
convFSL String
ts r :: ReadyForConstructionUkr
r@(FSL [[FlowSound]]
tsss) =  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([[FlowSound]] -> [String]) -> [[FlowSound]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> ([[FlowSound]] -> [[String]]) -> [[FlowSound]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
intersperse [String
" "] ([[String]] -> [[String]])
-> ([[FlowSound]] -> [[String]]) -> [[FlowSound]] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FlowSound] -> [String]) -> [[FlowSound]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((FlowSound -> String) -> [FlowSound] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [(FlowSound, String)] -> FlowSound -> String
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' String
" " [(FlowSound, String)]
ks) ) ([[FlowSound]] -> String) -> [[FlowSound]] -> String
forall a b. (a -> b) -> a -> b
$ [[FlowSound]]
tsss
   where js :: ([[FlowSound]], [[String]])
js = [([FlowSound], [String])] -> ([[FlowSound]], [[String]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([FlowSound], [String])] -> ([[FlowSound]], [[String]]))
-> (String -> [([FlowSound], [String])])
-> String
-> ([[FlowSound]], [[String]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], [FlowSound], [FlowSound]) -> ([FlowSound], [String]))
-> [([String], [FlowSound], [FlowSound])]
-> [([FlowSound], [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\([String]
rs,[FlowSound]
ps,[FlowSound]
_) -> ([FlowSound]
ps,[String]
rs)) ([([String], [FlowSound], [FlowSound])]
 -> [([FlowSound], [String])])
-> (String -> [([String], [FlowSound], [FlowSound])])
-> String
-> [([FlowSound], [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [([String], [FlowSound], [FlowSound])]
convF3 (String -> ([[FlowSound]], [[String]]))
-> String -> ([[FlowSound]], [[String]])
forall a b. (a -> b) -> a -> b
$ String
ts
         ks :: [(FlowSound, String)]
ks = [FlowSound] -> [String] -> [(FlowSound, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[FlowSound]] -> [FlowSound]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FlowSound]] -> [FlowSound])
-> (([[FlowSound]], [[String]]) -> [[FlowSound]])
-> ([[FlowSound]], [[String]])
-> [FlowSound]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[FlowSound]], [[String]]) -> [[FlowSound]]
forall a b. (a, b) -> a
fst (([[FlowSound]], [[String]]) -> [FlowSound])
-> ([[FlowSound]], [[String]]) -> [FlowSound]
forall a b. (a -> b) -> a -> b
$ ([[FlowSound]], [[String]])
js) ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> (([[FlowSound]], [[String]]) -> [[String]])
-> ([[FlowSound]], [[String]])
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[FlowSound]], [[String]]) -> [[String]]
forall a b. (a, b) -> b
snd (([[FlowSound]], [[String]]) -> [String])
-> ([[FlowSound]], [[String]]) -> [String]
forall a b. (a -> b) -> a -> b
$ ([[FlowSound]], [[String]])
js)

weightsString3IO :: Bool -> String -> IO ([[FlowSound]],[[[FlowSound]] -> [[Double]]],ReadyForConstructionUkr)
weightsString3IO :: Bool
-> String
-> IO
     ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
      ReadyForConstructionUkr)
weightsString3IO Bool
bool String
bs 
 | Bool
bool = do
   ([[FlowSound]]
syllDs1,[SyllWeights]
sylws,[[FlowSound]]
fsls0) <- String -> IO ([[FlowSound]], [SyllWeights], [[FlowSound]])
weightStringIO String
bs
   let syllableDurationsD2s :: [[[FlowSound]] -> [[Double]]]
syllableDurationsD2s = [[SyllWeights] -> [[FlowSound]] -> [[Double]]
weights2SyllableDurationsD [SyllWeights]
sylws]
   ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
 ReadyForConstructionUkr)
-> IO
     ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
      ReadyForConstructionUkr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[FlowSound]]
syllDs1,[[[FlowSound]] -> [[Double]]]
syllableDurationsD2s,[[FlowSound]] -> ReadyForConstructionUkr
FSL [[FlowSound]]
fsls0) 
 | Bool
otherwise = ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
 ReadyForConstructionUkr)
-> IO
     ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
      ReadyForConstructionUkr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],[[FlowSound]] -> ReadyForConstructionUkr
FSL [])

weightsString3NIO :: Int -> Bool -> String -> IO ([[FlowSound]],[[[FlowSound]] -> [[Double]]],ReadyForConstructionUkr)
weightsString3NIO :: Int
-> Bool
-> String
-> IO
     ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
      ReadyForConstructionUkr)
weightsString3NIO Int
n Bool
bool String
bs 
 | Bool
bool = (\([[FlowSound]]
syllDs1,[[SyllWeights]]
sylws,[[FlowSound]]
fsls0) -> ([[FlowSound]]
syllDs1,([SyllWeights] -> [[FlowSound]] -> [[Double]])
-> [[SyllWeights]] -> [[[FlowSound]] -> [[Double]]]
forall a b. (a -> b) -> [a] -> [b]
map [SyllWeights] -> [[FlowSound]] -> [[Double]]
weights2SyllableDurationsD [[SyllWeights]]
sylws,[[FlowSound]] -> ReadyForConstructionUkr
FSL [[FlowSound]]
fsls0)) (([[FlowSound]], [[SyllWeights]], [[FlowSound]])
 -> ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
     ReadyForConstructionUkr))
-> IO ([[FlowSound]], [[SyllWeights]], [[FlowSound]])
-> IO
     ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
      ReadyForConstructionUkr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String -> IO ([[FlowSound]], [[SyllWeights]], [[FlowSound]])
weightStringNIO Int
n String
bs
 | Bool
otherwise = ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
 ReadyForConstructionUkr)
-> IO
     ([[FlowSound]], [[[FlowSound]] -> [[Double]]],
      ReadyForConstructionUkr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([],[],[[FlowSound]] -> ReadyForConstructionUkr
FSL [])