{-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE NoImplicitPrelude, BangPatterns #-} -- | -- Module : Phladiprelio.Ukrainian.Melodics -- Copyright : (c) OleksandrZhabenko 2021-2024 -- License : MIT -- Maintainer : oleksandr.zhabenko@yahoo.com -- -- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis -- especially for poets, translators and writers. Is rewritten from the module Melodics.ByteString.Ukrainian.Arr -- for optimization purposes. -- Phonetic material is taken from the : -- -- Solomija Buk, Ján Mačutek, Andrij Rovenchak. Some properties of -- the Ukrainian writing system. [Electronic resource] https://arxiv.org/ftp/arxiv/papers/0802/0802.4198.pdf module Phladiprelio.Ukrainian.Melodics ( -- * Basic functions Sound8 , FlowSound , convertToProperUkrainianI8WithTuples , convertToProperUkrainianI8 , isUkrainianL , linkFileNameI8 -- * Transformation functions , дзT , жT , дT , гT , зT , цT , чT , шT , фT , кT , пT , сT , тT , хT , сьT , нтT , стT , тьT , цьT ) where import GHC.Base import GHC.List import GHC.Num ((-)) import Data.Maybe (fromJust) import Data.Char import GHC.Arr import CaseBi.Arr import Data.List (uncons) import GHC.Int import Phladiprelio.Ukrainian.Common2 -- | Is used to signify the optimization data type of 'Int8'. type Sound8 = Int8 type FlowSound = [Sound8] {-| The function that uses the following correspondence between the previous data type UZPP2 and the 'Sound8'. See for more implementation information: Starting from the version 0.6.0.0: -2 -> 102 -1 -> 101 0 -> 100 -} convertToProperUkrainianI8 :: String -> FlowSound convertToProperUkrainianI8 = let !tup1 = listArray (0,13) [(10,True),(17,True),(21,True),(25,True),(32,True),(38,True),(39,True), (41,True),(43,True),(45,True),(47,True),(49,True),(50,True),(52,True)] !tup2 = listArray (0,19) [(10,True),(15,True),(17,True),(19,True),(21,True),(25,True),(28,True), (30,True),(32,True),(34,True),(36,True),(38,True),(39,True),(41,True),(43,True),(45,True),(47,True), (49,True),(50,True),(52,True)] !tup3 = listArray (0,13) [(10,False),(17,False),(21,False),(25,False),(32,False),(38,False),(39,False), (41,False),(43,False),(45,False),(47,False),(49,False),(50,False),(52,False)] !tup4 = listArray (0,5) [(17,True),(32,True),(38,True),(49,True),(50,True),(52,True)] !tup5 = listArray (0,8) [([17,10],True),([17,25],True),([32,50],True),([38,7],True),([49,7],True), ([49,50],True),([50,7],True),([50,49],True),([52,21],True)] !tup6 = listArray (0,8) [([17,10],23),([17,25],8),([32,50],62),([38,7],66),([49,7],54), ([49,50],63), ([50,7],64),([50,49],38),([52,21],21)] !tup8 = listArray (0,7) [(8,True),(10,True),(15,True),(17,True),(19,True),(21,True),(23,True),(25, True)] !tup9 = listArray (0,10) [([15,7],True),([17,7],True),([28,7],True),([30,7],True),([32,7],True),([36,7],True), ([38,7],True),([43,7],True),([47,7],True),([49,7],True),([50,7],True)] !tup10 = listArray (0,4) [([12],True),([13],True),([14],True),([64],True),([65],True)] !tup11 = listArray (0,7) [([8,7],True),([17,7],True),([25,7],True),([28,7],True),([32,7],True),([38,7],True), ([49,7],True),([50,7],True)] tup7 = listArray (0,18) [(8, дзT tup9 tup10),(10, жT),(17, дT),(21, гT),(25, зT tup9 tup10),(38, цT tup8 tup9 tup10), (39, чT),(41, шT),(43, фT), (45, кT),(47, пT),(49, сT tup8 tup9 tup10),(50, тT tup8 tup11 tup10), (52, хT),(54, сьT),(62, нтT),(63, стT),(64, тьT),(66, цьT)] !tup12 = listArray (0,6) [(12,[8,7]),(13,[25,7]),(14,[17,7]),(62,[32,50]),(63,[49,50]),(64,[50,7]), (65,[32,7])] !tup13 = listArray (0,36) [('\'',102),('-',101),('\700',60),('\1072',1),('\1073',15),('\1074',36),('\1075',21), ('\1076',17),('\1077',2),('\1078',10),('\1079',25),('\1080',5),('\1081',27),('\1082',45),('\1083',28), ('\1084',30),('\1085',32),('\1086',3),('\1087',47),('\1088',34),('\1089',49),('\1090',50),('\1091',4), ('\1092',43),('\1093',52),('\1094',38),('\1095',39),('\1096',41),('\1097',55),('\1100',7),('\1102',56), ('\1103',57),('\1108',58),('\1110',6),('\1111',59),('\1169',19),('\8217',61)] !tup14 = listArray (0,8) [(55,[41,39]),(56,[27,4]),(57,[27,1]),(58,[27,2]),(59,[27,6]), (60,[101]),(61,[101]),(101,[101]),(102,[101])] !tup15 = listArray (0,15) [('\'',True),('-',True),('\700',True),('\1028',True),('\1030',True),('\1031',True), ('\1068',True),('\1100',True),('\1102',True),('\1103',True),('\1108',True),('\1110',True),('\1111',True), ('\1168',True),('\1169',True),('\8217',True)] !tup16 = listArray (0,20) [('\1073',True),('\1074',True),('\1075',True),('\1076',True),('\1078',True), ('\1079',True),('\1082',True),('\1083',True),('\1084',True),('\1085',True),('\1087',True),('\1088',True), ('\1089',True),('\1090',True),('\1092',True),('\1093',True),('\1094',True),('\1095',True),('\1096',True), ('\1097',True),('\1169',True)] in correctB . correctA tup12 . applyChanges tup7 . bsToCharUkr tup6 . createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 . secondConv tup14 . filterUkr tup13 . changeIotated tup16 . filter (\x -> isUkrainianLTup tup15 x || isSpace x || isControl x || isPunctuation x) . map toLower {-# INLINE convertToProperUkrainianI8 #-} {-| A full variant of the 'convertToProperUkrainianI8' function with all the elements for the 'getBFst'' function being provided as 'Array' 'Int' (data tuple). Can be useful to reduce number of calculations in the complex usage scenarios. -} convertToProperUkrainianI8WithTuples :: Array Int (Int8, Bool) -> Array Int (Int8, Bool) -> Array Int (Int8, Bool) -> Array Int (Int8, Bool) -> Array Int ([Int8], Bool) -> Array Int ([Int8], Int8) -> Array Int (Int8, FlowSound -> Sound8) -> Array Int (Int8, Bool) -> Array Int ([Int8], Bool) -> Array Int ([Int8], Bool) -> Array Int ([Int8], Bool) -> Array Int (Int8, [Int8]) -> Array Int (Char,Int8) -> Array Int (Int8,[Int8]) -> Array Int (Char, Bool) -> Array Int (Char, Bool) -> [Char] -> FlowSound convertToProperUkrainianI8WithTuples !tup1 !tup2 !tup3 !tup4 !tup5 !tup6 tup7 !tup8 !tup9 !tup10 !tup11 !tup12 !tup13 !tup14 !tup15 !tup16 = correctB . correctA tup12 . applyChanges tup7 . bsToCharUkr tup6 . createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 . secondConv tup14 . filterUkr tup13 . changeIotated tup16 . filter (\x -> isUkrainianLTup tup15 x || isSpace x || isControl x || isPunctuation x) . map toLower {-# INLINE convertToProperUkrainianI8WithTuples #-} changeIotated :: Array Int (Char,Bool) -> String -> String changeIotated !tup16 (x:y:zs) | (y `elem` ("\1102\1103\1108\1110"::String)) && isConsNotJTup tup16 x = x:'\1100':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated tup16 zs | x == '\'' || x == '\x2019' || x == '\x02BC' || x == '-' = if (y `elem` ("\1102\1103\1108\1110"::String)) then '\1081':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated tup16 zs else changeIotated tup16 (y:zs) | otherwise = x:changeIotated tup16 (y:zs) changeIotated _ xs = xs filterUkr :: Array Int (Char,Int8) -> String -> FlowSound filterUkr tup13 = let !tup = (100, tup13) in map (getBFst' tup) {-# INLINE filterUkr #-} secondConv :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound secondConv tup14 = concatMap (\y -> getBFst' ([y], tup14) y) {-# INLINE secondConv #-} createTuplesByAnalysis :: Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> FlowSound -> [FlowSound] createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 x@(h:ta) | getBFst' (False, tup1) h = initialA tup3 tup4 tup5 x | not (null ta) && (head ta == 27 && getBFst' (False, tup2) h) = [h]:[7]:createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 (drop 1 ta) | otherwise = [h]:createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 ta createTuplesByAnalysis _ _ _ _ _ _ = [] initialA :: Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> FlowSound -> [FlowSound] initialA tup3 tup4 tup5 t1@(t:ts) | t < 1 || t > 99 = [100]:initialA tup3 tup4 tup5 ts | getBFst' (True, tup3) t = [t]:initialA tup3 tup4 tup5 ts | getBFst' (False, tup4) t = let (us,vs) = splitAt 2 t1 in if getBFst' (False, tup5) us then us:initialA tup3 tup4 tup5 vs else [t]:initialA tup3 tup4 tup5 ts | otherwise = [t]:initialA tup3 tup4 tup5 ts initialA _ _ _ _ = [] bsToCharUkr :: Array Int ([Int8],Int8) -> [FlowSound] -> FlowSound bsToCharUkr tup6 zs@(_:_) = map (g tup6) zs where g tup6 ts@(t:_) = getBFst' (t, tup6) ts g _ _ = 101 bsToCharUkr _ _ = [] {-# INLINE bsToCharUkr #-} applyChanges :: Array Int (Int8,FlowSound -> Sound8) -> FlowSound -> FlowSound applyChanges tup7 ys = foldr f v ys where v = [] f x xs@(_:_) = getBFst' (\_ -> x, tup7) x xs:xs f x _ = [x] {-# INLINE applyChanges #-} isVoicedObstruent :: FlowSound -> Bool isVoicedObstruent (x:_) = x > 7 && x < 27 isVoicedObstruent _ = False {-# INLINE isVoicedObstruent #-} isVoicedObstruentH :: Array Int (Int8,Bool) -> FlowSound -> Bool isVoicedObstruentH tup8 (x:_) = getBFst' (False, tup8) x isVoicedObstruentH _ _ = False {-# INLINE isVoicedObstruentH #-} isVoicedObstruentS :: FlowSound -> Bool isVoicedObstruentS (x:_) = x > 11 && x < 15 isVoicedObstruentS _ = False {-# INLINE isVoicedObstruentS #-} isSoftDOrL :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Bool isSoftDOrL tup9 tup10 xs = getBFst' (False, tup9) (takeFromFT_ 2 xs) || getBFst' (False, tup10) (takeFromFT_ 1 xs) {-# INLINE isSoftDOrL #-} isSoftDen :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Bool isSoftDen tup11 tup10 xs = getBFst' (False, tup11) (takeFromFT_ 2 xs) || getBFst' (False, tup10) (takeFromFT_ 1 xs) {-# INLINE isSoftDen #-} гT :: FlowSound -> Sound8 гT (t:_) | t == 45 || t == 50 = 52 -- г х | otherwise = 21 гT _ = 21 {-# INLINE гT #-} дT :: FlowSound -> Sound8 дT t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] = 23 -- д дж | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] = 12 -- д дзь | takeFromFT_ 1 t1 `elem` [[54],[66]] = 12 -- д дзь | takeFromFT_ 1 t1 `elem` [[25],[49],[38]] = 8 -- д дз | otherwise = 17 дT _ = 17 {-# INLINE дT #-} дзT :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8 дзT tup9 tup10 t1@(_:_) | isSoftDOrL tup9 tup10 t1 = 12 -- дз дзь | otherwise = 8 дзT _ _ _ = 8 {-# INLINE дзT #-} жT :: FlowSound -> Sound8 жT t1@(_:_) | takeFromFT 2 t1 `elem` [[49,7],[38,7]] = 13 -- ж зь | takeFromFT 1 t1 `elem` [[54],[66]] = 13 | otherwise = 10 жT _ = 10 {-# INLINE жT #-} зT :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8 зT tup9 tup10 t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] || takeFromFT_ 2 t1 == [17,10] || takeFromFT_ 1 t1 == [23] = 10 -- з ж | isSoftDOrL tup9 tup10 t1 = 13 -- з зь | takeFromFT 1 t1 `elem` [[39],[41]] = 41 -- з ш | takeFromFT 1 t1 `elem` [[49],[38]] || takeFromFT_ 1 t1 `elem` [[45],[47],[50],[43],[52]] = 49 -- з с | otherwise = 25 зT _ _ _ = 25 {-# INLINE зT #-} кT :: FlowSound -> Sound8 кT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 19 | otherwise = 45 кT _ = 45 {-# INLINE кT #-} нтT :: FlowSound -> Sound8 нтT t1@(_:_) | takeFromFT 2 t1 == [49,50] || takeFromFT 1 t1 == [63] = 32 | takeFromFT 3 t1 == [49,7,45] || takeFromFT 2 t1 == [54,45] = 65 | otherwise = 62 нтT _ = 62 {-# INLINE нтT #-} пT :: FlowSound -> Sound8 пT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 15 | otherwise = 47 пT _ = 47 {-# INLINE пT #-} сT :: Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8 сT tup8 tup9 tup10 t1@(_:_) | ((isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || isVoicedObstruentS (takeFromFT_ 1 t1) = 13 | isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1 = 25 | isSoftDOrL tup9 tup10 t1 = 54 | takeFromFT_ 1 t1 == [41] = 41 | otherwise = 49 сT _ _ _ _ = 49 {-# INLINE сT #-} стT :: FlowSound -> Sound8 стT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 25 | takeFromFT_ 3 t1 == [49,7,45] || (takeFromFT_ 2 t1 `elem` [[54,45],[38,7]]) || takeFromFT_ 1 t1 == [66] = 54 | takeFromFT_ 1 t1 `elem` [[49],[32]] = 49 | takeFromFT_ 1 t1 == [39] = 41 | otherwise = 63 стT _ = 63 {-# INLINE стT #-} сьT :: FlowSound -> Sound8 сьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 13 | otherwise = 54 сьT _ = 54 {-# INLINE сьT #-} тT :: Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8 тT tup8 tup11 tup10 t1@(_:_) | ((isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || isVoicedObstruentS (takeFromFT_ 1 t1) = 14 | isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1 = 17 | takeFromFT_ 2 t1 == [38,7] || takeFromFT_ 1 t1 == [66] = 66 | takeFromFT_ 1 t1 == [38] = 38 | isSoftDen tup11 tup10 t1 = 64 | takeFromFT_ 1 t1 `elem` [[39],[41]] = 39 | otherwise = 50 тT _ _ _ _ = 50 {-# INLINE тT #-} тьT :: FlowSound -> Sound8 тьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 14 | takeFromFT_ 3 t1 == [49,7,1] || takeFromFT_ 2 t1 == [54,1] = 66 | otherwise = 64 тьT _ = 64 {-# INLINE тьT #-} фT :: FlowSound -> Sound8 фT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 36 | otherwise = 43 фT _ = 43 {-# INLINE фT #-} хT :: FlowSound -> Sound8 хT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 21 | otherwise = 52 хT _ = 52 {-# INLINE хT #-} цT :: Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8 цT tup8 tup9 tup10 t1@(_:_) | ((isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || isVoicedObstruentS (takeFromFT_ 1 t1) = 12 | isSoftDOrL tup9 tup10 t1 = 66 | isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1 = 8 | otherwise = 38 цT _ _ _ _ = 38 {-# INLINE цT #-} цьT :: FlowSound -> Sound8 цьT t1@(_:_) | (isVoicedObstruent . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7] = 12 | otherwise = 66 цьT _ = 66 {-# INLINE цьT #-} чT :: FlowSound -> Sound8 чT t1@(_:_) | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] || takeFromFT_ 1 t1 `elem` [[54],[66]] = 66 | isVoicedObstruent . takeFromFT_ 1 $ t1 = 23 | otherwise = 39 чT _ = 39 {-# INLINE чT #-} шT :: FlowSound -> Sound8 шT t1@(_:_) | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] || takeFromFT_ 1 t1 `elem` [[54],[66]] = 54 | isVoicedObstruent . takeFromFT_ 1 $ t1 = 10 | otherwise = 41 шT _ = 41 {-# INLINE шT #-} takeFromFT :: Int -> FlowSound -> FlowSound takeFromFT n ts | if n < 1 then True else null ts = [] | n < 2 = [k] | otherwise = k : takeFromFT (n - 1) (take (n - 1) ts) where k = head ts takeFromFT2 :: Int -> FlowSound -> FlowSound takeFromFT2 n ts | if n < 1 then True else null ts = [] | n < 2 = [ks] | otherwise = ks:takeFromFT2 (n - 1) (tail ts) where ks = head ts dropFromFT2 :: Int -> FlowSound -> FlowSound dropFromFT2 n ts | if n < 1 then True else null ts = [] | n < 2 = tail ts | otherwise = dropFromFT2 (n - 1) (tail ts) takeFromFT_ :: Int -> FlowSound -> FlowSound takeFromFT_ n = takeFromFT n . filter (\t -> t > 0 && t < 100) {-# INLINE takeFromFT_ #-} correctA :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound correctA tup12 = correctSomeW . separateSoftS tup12 {-# INLINE correctA #-} separateSoftS :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound separateSoftS tup12 = concatMap (\x -> getBFst' ([x], tup12) x) {-# INLINE separateSoftS #-} correctSomeW :: FlowSound -> FlowSound correctSomeW (x:y:z:xs@(t:ys)) | x == 50 && y == 7 && z == 54 && t == 1 = 66:66:1:correctSomeW ys | (x > 99) && y == 27 && z == 1 = if take 2 xs == [39,32] then x:y:z:41:correctSomeW ys else x:correctSomeW (y:z:xs) | otherwise = x:correctSomeW (y:z:xs) correctSomeW zs = zs correctB :: FlowSound -> FlowSound correctB ys@(x:xs) | (length . filter (== 100) . takeFromFT2 6 $ ys) > 1 = map (\t -> if t >= 100 then 101 else t) (takeFromFT2 6 ys) `mappend` correctB (dropFromFT2 6 ys) | otherwise = (if x > 100 then 101 else x):correctB xs correctB _ = [] -- | Can be used to map the 'Sound8' representation and the mmsyn6ukr-array files with some recordings. linkFileNameI8 :: Sound8 -> Char linkFileNameI8 = getBFstLSorted' '0' ([(1,'A'),(2,'H'),(3,'Q'),(4,'W'),(5,'K'),(6,'e'),(7,'d'),(8,'G'),(10,'I'),(15,'B'), (17,'E'),(19,'f'),(21,'D'),(23,'F'),(25,'J'),(27,'L'),(28,'N'),(30,'O'),(32,'P'),(34,'S'),(36,'C'),(38,'Z'),(39,'b'), (41,'c'),(43,'X'),(45,'M'),(47,'R'),(49,'T'),(50,'V'),(52,'Y'),(54,'U'),(60,'0'),(61,'0'),(66,'a')]) {-# INLINE linkFileNameI8 #-}