{-# OPTIONS_HADDOCK show-extensions #-}
-- |
-- Module : Melodics.Ukrainian.ArrInt8
-- Copyright : (c) OleksandrZhabenko 2021
-- License : MIT
-- Maintainer : olexandr543@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 Melodics.Ukrainian.ArrInt8 (
-- * Basic functions
Sound8
, FlowSound
, convertToProperUkrainianI8
, isUkrainianL
, linkFileNameI8
) where
import Data.Maybe (fromJust)
import Data.Char
import GHC.Arr
import CaseBi.Arr
import Data.List (uncons)
import GHC.Int
import Melodics.Ukrainian.Common
-- | 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'.
@
UZ \'A\' D дз (plain) 8
UZ \'A\' K дз (palatalized) 9
UZ \'B\' D ж (plain) 10
UZ \'B\' K ж (semi-palatalized) 11
UZ \'C\' S й 27
UZ \'D\' N сь 54
UZ \'E\' L ч (plain) 39
UZ \'E\' M ч (semi-palatalized) 40
UZ \'F\' L ш (plain) 41
UZ \'F\' M ш (semi-palatalized) 42
G 55
H 56
I 57
J 58
K 59
L 60
M 61
N нт 62
O ст 63
P ть 64
Q дзь 12
R зь 13
S нь 65
T дь 14
UZ \'a\' W а 1
UZ \'b\' D б (plain) 15
UZ \'b\' K б (semi-palatalized) 16
UZ \'c\' D ц (plain) 38
UZ \'d\' D д (plain) 17
UZ \'d\' K д (palatalized) 18
UZ \'e\' W е 2
UZ \'f\' L ф (plain) 43
UZ \'f\' M ф (semi-palatalized) 44
UZ \'g\' D ґ (plain) 19
UZ \'g\' K ґ (semi-palatalized) 20
UZ \'h\' D г (plain) 21
UZ \'h\' K г (semi-palatalized) 22
UZ \'i\' W і 6
UZ \'j\' D дж (plain) 23
UZ \'j\' K дж (palatalized) 24
UZ \'k\' L к (plain) 45
UZ \'k\' M к (semi-palatalized) 46
UZ \'l\' S л (plain) 28
UZ \'l\' O л (palatalized) 29
UZ \'m\' S м (plain) 30
UZ \'m\' O м (semi-palatalized) 31
UZ \'n\' S н (plain) 32
UZ \'n\' O н (palatalized) 33
UZ \'o\' W о 3
UZ \'p\' L п (plain) 47
UZ \'p\' M п (semi-palatalized) 48
UZ \'q\' E ь 7
UZ \'r\' S р (plain) 34
UZ \'r\' O р (palatalized) 35
UZ \'s\' L с (plain) 49
UZ \'t\' L т (plain) 50
UZ \'t\' M т (palatalized) 51
UZ \'u\' W у 4
UZ \'v\' S в (plain) 36
UZ \'v\' O в (semi-palatalized) 37
UZ \'w\' N ць 66
UZ \'x\' L х (plain) 52
UZ \'x\' M х (semi-palatalized) 53
UZ \'y\' W и 5
UZ \'z\' D з (plain) 25
UZ \'z\' K з (palatalized) 26
@
-}
convertToProperUkrainianI8 :: String -> FlowSound
convertToProperUkrainianI8 = correctB . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv .
filterUkr . changeIotated . filter (\x -> isUkrainianL x || isSpace x || isControl x || isPunctuation x) . map toLower
changeIotated :: String -> String
changeIotated (x:y:zs)
| (y `elem` ("\1102\1103\1108\1110"::String)) && isConsNotJ x = x:'\1100':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated zs
| otherwise = x:changeIotated (y:zs)
changeIotated xs = xs
filterUkr :: String -> FlowSound
filterUkr = map toBSUkr
toBSUkr :: Char -> Sound8
toBSUkr = getBFstLSorted' 0 (zip "'-\700\1072\1073\1074\1075\1076\1077\1078\1079\1080\1081\1082\1083\1084\1085\1086\1087\1088\1089\1090\1091\1092\1093\1094\1095\1096\1097\1100\1102\1103\1108\1110\1111\1169\8217" [-2,-1,60,1,15,36,21,17,2,10,25,5,27,45,28,30,32,3,47,34,49,50,4,43,52,38,39,41,55,7,56,57,58,6,59,19,61])
secondConv :: FlowSound -> FlowSound
secondConv =
concatMap (\y -> getBFstLSorted' [y] (zip [-2,-1,55,56,57,58,59,60,61] [[-1],[-1],[41,39],[27,4],[27,1],[27,2],[27,6],[-1],[-1]]) y)
createTuplesByAnalysis :: FlowSound -> [FlowSound]
createTuplesByAnalysis x
| null x = []
| getBFstLSorted' False (zip [10,17,21,25,32,38,39,41,43,45,47,49,50,52] (repeat True)) . head $ x = initialA x
| not (null . tail $ x) && (x !! 1 == 27 && isConsNotJ8 (head x)) = take 1 x:[7]:createTuplesByAnalysis (drop 2 x)
| otherwise = take 1 x:createTuplesByAnalysis (tail x)
isConsNotJ8 :: Int8 -> Bool
isConsNotJ8 = getBFstLSorted' False (zip [10,15,17,19,21,25,28,30,32,34,36,38,39,41,43,45,47,49,50,52] (repeat True))
initialA :: FlowSound -> [FlowSound]
initialA t1@(t:ts)
| t < 1 = [0]:initialA ts
| getBFstLSorted' True (zip [10,17,21,25,32,38,39,41,43,45,47,49,50,52] (repeat False)) t = [t]:initialA ts
| getBFstLSorted' False (zip [17,32,38,49,50,52] (repeat True)) t =
let (us,vs) = splitAt 2 t1 in
if getBFstLSorted' False (zip [[17,10],[17,25],[32,50],[38,7],[49,7],[49,50],[50,7],[50,49],[52,21]] (repeat True)) us
then us:initialA vs
else [t]:initialA ts
| otherwise = [t]:initialA ts
initialA _ = []
bsToCharUkr :: [FlowSound] -> FlowSound
bsToCharUkr zs
| null zs = []
| otherwise = map g zs
where g ts
| null ts = -1
| otherwise = getBFstLSorted' (head ts) [([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)] ts
applyChanges :: FlowSound -> FlowSound
applyChanges [] = []
applyChanges ys = foldr f v ys
where v = []
f x xs
| null xs = [x]
| otherwise = getBFstLSorted' x (zip [8,10,17,21,25,38,39,41,43,45,47,49,50,52,54,62,63,64,66] [дзT xs,
жT xs, дT xs, гT xs, зT xs, цT xs, чT xs, шT xs, фT xs, кT xs, пT xs, сT xs, тT xs, хT xs,
сьT xs, нтT xs, стT xs, тьT xs, цьT xs]) x:xs
isVoicedObstruent :: FlowSound -> Bool
isVoicedObstruent xs
| null xs = False
| otherwise = (\u -> u > 7 && u < 27) . head $ xs
isVoicedObstruentH :: FlowSound -> Bool
isVoicedObstruentH xs
| null xs = False
| otherwise = getBFstLSorted' False [(8,True),(10,True),(15,True),(17,True),(19,True),(21,True),(23,True),(25, True)] . head $ xs
isVoicedObstruentS :: FlowSound -> Bool
isVoicedObstruentS xs
| null xs = False
| otherwise = (\u -> u > 11 && u < 15) . head $ xs
isSoftDOrL :: FlowSound -> Bool
isSoftDOrL xs = getBFstLSorted' False (zip [[15,7],[17,7],[28,7],[30,7],[32,7],[36,7],[38,7],[43,7],[47,7],[49,7],[50,7]]
(repeat True)) (takeFromFT_ 2 xs) || getBFstLSorted' False (zip [[12],[13],[14],[64],[65]] . repeat $ True)
(takeFromFT_ 1 xs)
isSoftDen :: FlowSound -> Bool
isSoftDen xs = getBFstLSorted' False (zip [[8,7],[17,7],[25,7],[28,7],[32,7],[38,7],[49,7],[50,7]] . repeat $ True)
(takeFromFT_ 2 xs) || getBFstLSorted' False (zip [[12],[13],[14],[64],[65]] . repeat $ True)
(takeFromFT_ 1 xs)
гT :: FlowSound -> Sound8
гT (t:_) | t == 45 || t == 50 = 52 -- г х
| otherwise = 21
гT _ = 21
д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
дзT :: FlowSound -> Sound8
дзT t1@(_:_) | isSoftDOrL t1 = 12 -- дз дзь
| otherwise = 8
дзT _ = 8
ж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
зT :: FlowSound -> Sound8
зT t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] || takeFromFT_ 2 t1 == [17,10] || takeFromFT_ 1 t1 == [23] = 10 -- з ж
| isSoftDOrL 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
кT :: FlowSound -> Sound8
кT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 19
| otherwise = 45
кT _ = 45
нт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
пT :: FlowSound -> Sound8
пT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 15
| otherwise = 47
пT _ = 47
сT :: FlowSound -> Sound8
сT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) ||
isVoicedObstruentS (takeFromFT_ 1 t1) = 13
| isVoicedObstruentH . takeFromFT_ 1 $ t1 = 25
| isSoftDOrL t1 = 54
| takeFromFT_ 1 t1 == [41] = 41
| otherwise = 49
сT _ = 49
ст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
сьT :: FlowSound -> Sound8
сьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 13
| otherwise = 54
сьT _ = 54
тT :: FlowSound -> Sound8
тT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) ||
isVoicedObstruentS (takeFromFT_ 1 t1) = 14
| isVoicedObstruentH . takeFromFT_ 1 $ t1 = 17
| takeFromFT_ 2 t1 == [38,7] || takeFromFT_ 1 t1 == [66] = 66
| takeFromFT_ 1 t1 == [38] = 38
| isSoftDen t1 = 64
| takeFromFT_ 1 t1 `elem` [[39],[41]] = 39
| otherwise = 50
тT _ = 50
ть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
фT :: FlowSound -> Sound8
фT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 36
| otherwise = 43
фT _ = 43
хT :: FlowSound -> Sound8
хT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 21
| otherwise = 52
хT _ = 52
цT :: FlowSound -> Sound8
цT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) ||
isVoicedObstruentS (takeFromFT_ 1 t1) = 12
| isSoftDOrL t1 = 66
| isVoicedObstruentH . takeFromFT_ 1 $ t1 = 8
| otherwise = 38
цT _ = 38
цьT :: FlowSound -> Sound8
цьT t1@(_:_) | (isVoicedObstruent . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7] = 12
| otherwise = 66
цьT _ = 66
ч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
ш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
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 (>0)
correctA :: FlowSound -> FlowSound
correctA = correctSomeW . separateSoftS
separateSoftS :: FlowSound -> FlowSound
separateSoftS = concatMap divideToParts
correctSomeW :: FlowSound -> FlowSound
correctSomeW (x:y:z:xs@(t:ys))
| x == 50 && y == 7 && z == 54 && t == 1 = 66:66:1:correctSomeW ys
| (x < 1) && 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
divideToParts :: Sound8 -> FlowSound
divideToParts x =
getBFstLSorted' [x] [(12,[8,7]),(13,[25,7]),(14,[17,7]),(62,[32,50]),(63,[49,50]),(64,[50,7]), (65,[32,7])] x
correctB :: FlowSound -> FlowSound
correctB ys@(x:xs)
| (length . filter (== 0) . takeFromFT2 6 $ ys) > 1 = map (\t -> if t <= 0 then -1 else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys)
| otherwise = (if x < 0 then -1 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 x = 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')]) x