{-# OPTIONS_HADDOCK show-extensions #-}
{-# 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
, 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)
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 [])