{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phladiprelio.Ukrainian.PropertiesFuncRepG2
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- 

{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}

module Phladiprelio.Ukrainian.Emphasis where

import GHC.Base
import Text.Show (Show(..))
import GHC.List
import GHC.Num ((+),(-))
import GHC.Real (fromIntegral)
import Data.Tuple (fst,snd)
import Phladiprelio.Ukrainian.Syllable
import Phladiprelio.Ukrainian.Melodics
import Phladiprelio.Ukrainian.SyllableDouble (syllableDurationsGD)
import GHC.Int
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import Data.Char (toUpper)
import GHC.Arr
import Data.List (scanl',intersperse,words)
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 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 :: [FlowSound] -> IO [SyllWeights]
weightSyllablesIO :: [FlowSound] -> IO [SyllWeights]
weightSyllablesIO = 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)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> FlowSound -> IO Double
weightSyllAIO Bool
False FlowSound
xs)  forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[SyllWeights]
zs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[FlowSound]]
tsss, [SyllWeights]
zs, FlowSound -> [[FlowSound]]
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
$ [[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 = 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] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[[SyllWeights]]
zss -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[FlowSound]]
tsss, [[SyllWeights]]
zss, FlowSound -> [[FlowSound]]
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
$ [[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 = 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 (\(Sy FlowSound
_ Int8
i Double
w) -> (Int8
i,Double
w)) forall a b. (a -> b) -> a -> b
$ [SyllWeights]
xs
  where l :: Int
l = forall a. [a] -> Int
length [SyllWeights]
xs

weights2SyllableDurationsD :: [SyllWeights] -> [[[Sound8]]] -> [[Double]]
weights2SyllableDurationsD :: [SyllWeights] -> [[FlowSound]] -> [[Double]]
weights2SyllableDurationsD [SyllWeights]
xs = (Int8 -> Double) -> [[FlowSound]] -> [[Double]]
syllableDurationsGD (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) = 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]
:FlowSound -> [[FlowSound]]
helper1F (Int8
yforall a. a -> [a] -> [a]
:FlowSound
ys)
helper1F FlowSound
_ = []

weightSyllAIO :: Bool -> FlowSound -> IO Double
weightSyllAIO :: Bool -> FlowSound -> IO Double
weightSyllAIO Bool
upper FlowSound
xs
  | forall a. [a] -> Bool
null FlowSound
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
. FlowSound -> String
showFS forall a b. (a -> b) -> a -> b
$ FlowSound
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 ReadyForConstructionUkr = Str String | FSL [[FlowSound]] deriving (ReadyForConstructionUkr -> ReadyForConstructionUkr -> Bool
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
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
Ord)

showR :: ReadyForConstructionUkr -> String
showR :: ReadyForConstructionUkr -> String
showR (Str String
xs) = String
xs
showR (FSL [[FlowSound]]
tsss) = 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) = forall a. a -> Maybe a
Just String
xs
fromReadyFCUkrS ReadyForConstructionUkr
_ = forall a. Maybe a
Nothing

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

helper2F :: [b] -> [a] -> [a] -> [[a]] -> [([b],[a],[a])]
helper2F :: forall b a. [b] -> [a] -> [a] -> [[a]] -> [([b], [a], [a])]
helper2F [b]
vs [a]
xs [a]
ys [[a]]
tss = let ([b]
us,[a]
ks,[a]
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
$ [a]
ys in
  forall {a} {a} {a} {a}.
[a] -> [a] -> [a] -> [[a]] -> [([a], [a], [a])]
helper2F' [b]
us [a]
ks [a]
rs [[a]]
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 :: String -> [[FlowSound]]
convF1 :: String -> [[FlowSound]]
convF1 String
xs
 | forall a. [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
 | forall a. [a] -> Bool
null String
xs = [([],[],[])]
 | Bool
otherwise = forall b a. [b] -> [a] -> [a] -> [[a]] -> [([b], [a], [a])]
helper2F (forall a b. (a -> [b]) -> [a] -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map FlowSound -> String
showFS) [[FlowSound]]
tsss) (forall a b. (a -> b) -> [a] -> [b]
map (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
 | forall a. [a] -> Bool
null String
xs = [([],[])]
 | Bool
otherwise = 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
xs

convFI :: String -> String -> [[FlowSound]]
convFI :: String -> String -> [[FlowSound]]
convFI String
ts = forall a b. (a -> b) -> [a] -> [b]
map String -> [FlowSound]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
  where !f :: String -> [FlowSound]
f = 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) = 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,[FlowSound]
_,[FlowSound]
_)-> [String]
ks) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [([String], [FlowSound], [FlowSound])]
convF3 forall a b. (a -> b) -> a -> b
$ String
xs
   where js :: ([[FlowSound]], [[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,[FlowSound]
ps,[FlowSound]
_) -> ([FlowSound]
ps,[String]
rs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [([String], [FlowSound], [FlowSound])]
convF3 forall a b. (a -> b) -> a -> b
$ String
ts
convFSL String
ts r :: ReadyForConstructionUkr
r@(FSL [[FlowSound]]
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
" " [(FlowSound, String)]
ks) ) forall a b. (a -> b) -> a -> b
$ [[FlowSound]]
tsss
   where js :: ([[FlowSound]], [[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,[FlowSound]
ps,[FlowSound]
_) -> ([FlowSound]
ps,[String]
rs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [([String], [FlowSound], [FlowSound])]
convF3 forall a b. (a -> b) -> a -> b
$ String
ts
         ks :: [(FlowSound, 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
$ ([[FlowSound]], [[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
$ ([[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]
   forall (m :: * -> *) a. Monad m => a -> m a
return ([[FlowSound]]
syllDs1,[[[FlowSound]] -> [[Double]]]
syllableDurationsD2s,[[FlowSound]] -> ReadyForConstructionUkr
FSL [[FlowSound]]
fsls0) 
 | Bool
otherwise = 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,forall a b. (a -> b) -> [a] -> [b]
map [SyllWeights] -> [[FlowSound]] -> [[Double]]
weights2SyllableDurationsD [[SyllWeights]]
sylws,[[FlowSound]] -> ReadyForConstructionUkr
FSL [[FlowSound]]
fsls0)) 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([],[],[[FlowSound]] -> ReadyForConstructionUkr
FSL [])