module Melodics.Ukrainian (
appendS16LEFile,
convertToProperUkrainian,
nSymbols
) where
import Data.Char
import Data.List (groupBy)
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy as B
import System.IO
import CaseBi (getBFst')
import Data.List.InnToOut.Basic
import Paths_mmsyn6ukr
data Triple = Z | O | T
deriving (Eq,Ord,Show)
takeData :: FilePath -> IO B.ByteString
takeData file = do
data1 <- B.readFile file
let dataN = B.drop 44 data1 in return dataN
appendS16LEFile :: V.Vector String -> Handle -> IO ()
appendS16LEFile xs hdl | not (V.null xs) =
do
dataFileList <- mapM getDataFileName
["0.wav", "1.wav", "A.wav", "B.wav", "C.wav", "D.wav", "E.wav", "F.wav", "G.wav", "H.wav",
"I.wav", "J.wav", "K.wav", "L.wav", "M.wav", "N.wav", "O.wav", "P.wav", "Q.wav", "R.wav",
"S.wav", "T.wav", "U.wav", "V.wav", "W.wav", "X.wav", "Y.wav", "Z.wav", "a.wav", "b.wav", "c.wav",
"d.wav", "e.wav", "f.wav"]
dataList <- V.mapM takeData . V.fromList $! dataFileList
V.mapM_ (\u ->
if V.all (\z -> B.length z > 0) dataList
then let rs = tail . dropWhile (/= ' ') . takeWhile (/= '}') . show $ hdl in do
hClose hdl
closedHdl <- hIsClosed hdl
if closedHdl
then do
B.appendFile rs $ dataList V.! (getBFst' (0, V.fromList [("0", 0), ("1", 1), ("а", 2), ("б", 3),
("в", 4), ("г", 5), ("д", 6), ("дж", 7), ("дз", 8), ("е", 9), ("ж", 10), ("з", 11), ("и", 12),
("й", 13), ("к", 14), ("л", 15), ("м", 16), ("н", 17), ("о", 18), ("п", 19), ("р", 20),
("с", 21), ("сь", 22), ("т", 23), ("у", 24), ("ф", 25), ("х", 26), ("ц", 27), ("ць", 28), ("ч", 29),
("ш", 30), ("ь", 31), ("і", 32), ("ґ", 33)]) u)
else error "File is not closed!"
else error "Data sound file is not read!") xs
hClose hdl
| otherwise = return ()
convertToProperUkrainian :: String -> V.Vector String
convertToProperUkrainian ys = let ks = createTuplesByAnalysis . wasFstConverted . filterUkr $ ys in toVector . correctA $ ks
filterUkr :: String -> String
filterUkr xs = concatMap (\x -> if isUkrainian x then [toLower x] else if isSpace x || isControl x then [x] else []) xs
createTuplesByAnalysis :: String -> [(String, Triple)]
createTuplesByAnalysis x@(y:ys) | isSpace y || isControl y || y == '-' = ("1", Z):createTuplesByAnalysis ys
| getBFst' (False, V.fromList $ zip "\1075\1076\1078\1079\1082\1085\1087\1089\1090\1092\1093\1094\1095\1096" (repeat True)) y =
let ts = changeJotted x in applyChanges . initialA . groupBy isSimilar $ ts
| not (null ys) && head ys == '\1081' && isConsNotJ y = case y of
'\1089' -> ("\1089\1100", T):createTuplesByAnalysis (tail ys)
'\1094' -> ("\1094\1100", T):createTuplesByAnalysis (tail ys)
_ -> ([y], T):("\1100", Z):createTuplesByAnalysis (tail ys)
| otherwise = ([y], Z):createTuplesByAnalysis ys
createTuplesByAnalysis _ = []
canChange :: String -> Triple
canChange ~(x:_) | isSpace x || isControl x || x == '-' = O
| getBFst' (False, V.fromList $ zip "\1075\1076\1078\1079\1082\1085\1087\1089\1090\1092\1093\1094\1095\1096" (repeat True)) x = T
| otherwise = Z
isVoicedObstruent :: String -> Bool
isVoicedObstruent xs | not (null xs) = getBFst' (False, V.fromList $ zip ["\1073","\1075","\1076","\1076\1078","\1076\1079","\1078","\1079","\1169"] (repeat True)) xs
| otherwise = False
initialA :: [String] -> [(String, Triple)]
initialA (t:ts) | null t = initialA ts
| tu == O = ("_", Z):initialA (tail t:ts)
| (tu == T) =
if getBFst' (False, V.fromList $ zip ["\1076","\1085","\1089","\1090","\1093","\1094"] (repeat True)) ht
then let (us,vs) = splitAt 2 t in
if getBFst' (False, V.fromList $ zip ["\1076\1078","\1076\1079","\1085\1090","\1089\1090","\1089\1100","\1090\1089","\1090\1100","\1093\1075","\1094\1100"] (repeat True)) us
then (us, T):initialA (vs:ts)
else (ht, T):initialA (tail t:ts)
else case (getBFst' (False, V.fromList $ zip ["\1075","\1078","\1079","\1082","\1087","\1092","\1095","\1096"] (repeat True)) ht) of
~True -> (ht, T):initialA (tail t:ts)
| otherwise = (ht, Z):initialA (tail t:ts)
where ht = [head t]
tu = canChange ht
initialA _ = []
wasFstConverted :: String -> String
wasFstConverted = mapI mustBeConverted convertionFst
mustBeConverted :: Char -> Bool
mustBeConverted c = getBFst' (False, V.fromList $ zip "'-\700\1097\1102\1103\1108\1111\8217" (repeat True)) c
convertionFst :: Char -> String
convertionFst u = getBFst' ([u], V.fromList $ zip "'-\700\1097\1102\1103\1108\1111\8217" ["0","0","0","\1096\1095","\1081\1091","\1081\1072","\1081\1077","\1081\1110","0"]) u
isConsNotJ :: Char -> Bool
isConsNotJ = getBFst' (False, V.fromList $ zip "\1073\1074\1075\1076\1078\1079\1082\1083\1084\1085\1087\1088\1089\1090\1092\1093\1094\1095\1096\1169" (repeat True))
changeJotted :: String -> String
changeJotted (x:y:z:zs) | (getBFst' (False, V.fromList $ zip "\1072\1077\1080\1091\1110" (repeat True)) z) && (y == '\1081') && (isConsNotJ x) = x:'\1100':z:changeJotted zs
| isConsNotJ x && y == '\1110' = x:'\1100':y:changeJotted (z:zs)
| otherwise = x:changeJotted (y:z:zs)
changeJotted xs = xs
isNotVowel :: Char -> Bool
isNotVowel = getBFst' (True, V.fromList $ zip "\1072\1077\1080\1086\1091\1102\1103\1108\1110\1111" (repeat False))
isSimilar :: Char -> Char -> Bool
isSimilar x y = isNotVowel x && isNotVowel y
applyChanges :: [(String, Triple)] -> [(String, Triple)]
applyChanges (z:t:zs) | snd z == T =
getBFst' ((fst z, Z), V.fromList . zip ["\1075","\1076","\1076\1079","\1078","\1079","\1082","\1085\1090",
"\1087","\1089","\1089\1090","\1089\1100","\1090","\1090\1089","\1090\1100","\1092","\1093","\1093\1075","\1094","\1094\1100","\1095","\1096"]
$ [гT zs, дT zs, дзT zs, жT zs, зT zs, кT zs,
нтT zs, пT zs, сT zs, стT zs, сьT zs, тT zs, тсT zs, тьT zs,
фT zs, хT zs, хгT zs, цT zs, цьT zs, чT zs, шT zs]) (fst z):applyChanges (t:zs)
| otherwise = z:applyChanges (t:zs)
applyChanges [(xs, _)] = [(xs, Z)]
applyChanges _ = []
(===) :: Eq a => a -> [a] -> Bool
(===) x ys = or . map (\y -> x == y) $ ys
isSoftDOrL :: [(String, Triple)] -> Bool
isSoftDOrL xs = getBFst' (False, V.fromList . zip ["\1073\1100","\1074\1100","\1076\1100","\1079\1100","\1083\1100",
"\1084\1100","\1085\1100","\1087\1100","\1089\1100","\1090\1100","\1092\1100","\1094\1100"] $ (repeat True)) (takeFromFT_ 2 xs)
isSoftDen :: [(String, Triple)] -> Bool
isSoftDen xs = getBFst' (False, V.fromList . zip ["\1076\1100","\1079\1100","\1083\1100","\1085\1100","\1089\1100",
"\1090\1100","\1094\1100"] $ (repeat True)) (takeFromFT_ 2 xs) || takeFromFT_ 3 xs == "\1076\1079\1100"
гT :: [(String, Triple)] -> (String, Triple)
гT (t:_) | head (fst t) == '\1082' || head (fst t) == '\1090' = ("\1093", Z)
| otherwise = ("\1075", Z)
гT _ = ("г", Z)
дT :: [(String, Triple)] -> (String, Triple)
дT t1@(_:_) | takeFromFT_ 1 t1 === ["\1078","\1095","\1096"] = ("\1076\1078", Z)
| takeFromFT_ 2 t1 === ["\1089\1100","\1094\1100"] = ("\1076\1079\1100", T)
| takeFromFT_ 1 t1 === ["\1079","\1089","\1094"] = ("\1076\1079", Z)
| otherwise = ("\1076", Z)
дT _ = ("д", Z)
дзT :: [(String, Triple)] -> (String, Triple)
дзT t1@(_:_) | isSoftDOrL t1 = ("\1076\1079\1100", T)
| otherwise = ("\1076\1079", Z)
дзT _ = ("дз", Z)
жT :: [(String, Triple)] -> (String, Triple)
жT t1@(_:_) | takeFromFT 2 t1 === ["\1089\1100","\1094\1100"] = ("\1079\1100", T)
| otherwise = ("\1078", Z)
жT _ = ("ж", Z)
зT :: [(String, Triple)] -> (String, Triple)
зT t1@(_:_) | takeFromFT_ 1 t1 === ["\1078","\1095","\1096"] || takeFromFT_ 2 t1 == "\1076\1078" = ("\1078", Z)
| isSoftDOrL t1 = ("\1079\1100", T)
| takeFromFT 1 t1 === ["\1095","\1096"] = ("\1096", Z)
| takeFromFT 1 t1 === ["\1089","\1094"] || takeFromFT_ 1 t1 === ["\1082","\1087","\1090","\1092","\1093"] = ("\1089", Z)
| otherwise = ("\1079", Z)
зT _ = ("з", Z)
кT :: [(String, Triple)] -> (String, Triple)
кT t1@(_:_) | isVoicedObstruent (takeFromFT_ 1 t1) || isVoicedObstruent (takeFromFT_ 2 t1) = ("\1169", Z)
| otherwise = ("\1082", Z)
кT _ = ("к", Z)
нтT :: [(String, Triple)] -> (String, Triple)
нтT t1@(_:_) | takeFromFT 2 t1 == "\1089\1090" = ("\1085", Z)
| takeFromFT 3 t1 == "\1089\1100\1082" = ("\1085\1100", T)
| otherwise = ("\1085\1090", Z)
нтT _ = ("нт", T)
пT :: [(String, Triple)] -> (String, Triple)
пT t1@(_:_) | isVoicedObstruent (takeFromFT_ 1 t1) || isVoicedObstruent (takeFromFT_ 2 t1) = ("\1073", Z)
| otherwise = ("\1087", Z)
пT _ = ("п", Z)
сT :: [(String, Triple)] -> (String, Triple)
сT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") ||
(isVoicedObstruent (takeFromFT_ 2 t1) && drop 2 (takeFromFT_ 3 t1) == "\1100") = ("\1079\1100", T)
| isVoicedObstruent (takeFromFT_ 1 t1) || isVoicedObstruent (takeFromFT_ 2 t1) = ("\1073", Z)
| isSoftDOrL t1 = ("\1089\1100", Z)
| takeFromFT_ 1 t1 == "\1096" = ("\1096", Z)
| otherwise = ("\1089", Z)
сT _ = ("с", Z)
стT :: [(String, Triple)] -> (String, Triple)
стT t1@(_:_) | isVoicedObstruent (takeFromFT_ 1 t1) || isVoicedObstruent (takeFromFT_ 2 t1) = ("\1079", Z)
| takeFromFT_ 3 t1 == "\1089\1100\1082" || takeFromFT_ 2 t1 == "\1094\1100" = ("\1089\1100", Z)
| takeFromFT_ 1 t1 === ["\1089","\1085"] = ("\1089", Z)
| takeFromFT_ 1 t1 == "\1095" = ("\1096", Z)
| otherwise = ("\1089\1090", T)
стT _ = ("ст", T)
сьT :: [(String, Triple)] -> (String, Triple)
сьT t1@(_:_) | isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1079\1100", T)
| otherwise = ("\1089\1100", Z)
сьT _ = ("сь", Z)
тT :: [(String, Triple)] -> (String, Triple)
тT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") ||
(isVoicedObstruent (takeFromFT_ 2 t1) && drop 2 (takeFromFT_ 3 t1) == "\1100") = ("\1076\1100", T)
| isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1076", Z)
| takeFromFT_ 2 t1 == "\1094\1100" = ("\1094\1100", Z)
| takeFromFT_ 1 t1 == "\1094" = ("\1094", Z)
| isSoftDen t1 = ("\1090\1100", T)
| takeFromFT_ 1 t1 === ["\1095","\1096"] = ("\1095", Z)
| otherwise = ("\1090", Z)
тT _ = ("т", Z)
тсT :: [(String, Triple)] -> (String, Triple)
тсT _ = ("\1094", Z)
тьT :: [(String, Triple)] -> (String, Triple)
тьT t1@(_:_) | isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1076\1100", T)
| takeFromFT_ 3 t1 == "\1089\1100\1072" = ("\1094\1100", Z)
| otherwise = ("\1090\1100", T)
тьT _ = ("ть", T)
фT :: [(String, Triple)] -> (String, Triple)
фT t1@(_:_) | isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1074", Z)
| otherwise = ("\1092", Z)
фT _ = ("ф", Z)
хT :: [(String, Triple)] -> (String, Triple)
хT t1@(_:_) | isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1075", Z)
| otherwise = ("\1093", Z)
хT _ = ("х", Z)
хгT :: [(String, Triple)] -> (String, Triple)
хгT _ = ("\1075", Z)
цT :: [(String, Triple)] -> (String, Triple)
цT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") ||
(isVoicedObstruent (takeFromFT_ 2 t1) && drop 2 (takeFromFT_ 3 t1) == "\1100") = ("\1076\1079\1100", T)
| isSoftDOrL t1 = ("\1094\1100", Z)
| isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1076\1079", Z)
| otherwise = ("\1094", Z)
цT _ = ("ц", Z)
цьT :: [(String, Triple)] -> (String, Triple)
цьT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") ||
(isVoicedObstruent (takeFromFT_ 2 t1) && drop 2 (takeFromFT_ 3 t1) == "\1100") = ("\1076\1079\1100", T)
| otherwise = ("\1094\1100", Z)
цьT _ = ("ць", Z)
чT :: [(String, Triple)] -> (String, Triple)
чT t1@(_:_) | takeFromFT_ 2 t1 === ["\1089\1100","\1094\110"] = ("\1094\1100", Z)
| isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1076\1078", Z)
| otherwise = ("\1095", Z)
чT _ = ("ч", Z)
шT :: [(String, Triple)] -> (String, Triple)
шT t1@(_:_) | takeFromFT_ 2 t1 === ["\1089\1100","\1094\110"] = ("\1089\1100", Z)
| isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1078", Z)
| otherwise = ("\1096", Z)
шT _ = ("ш", Z)
correctA :: [(String, Triple)] -> [(String, Triple)]
correctA = correctSomeW . separateSoftS
separateSoftS :: [(String, Triple)] -> [(String, Triple)]
separateSoftS xs = mapI (\x -> snd x == T) divideToParts xs
divideToParts :: (String, Triple) -> [(String, Triple)]
divideToParts (xs, _) = [(init xs, Z),([last xs], Z)]
correctSomeW :: [(String, Triple)] -> [(String, Triple)]
correctSomeW (x:y:z:xs) | fst x == "\1094\1100" && fst y == "\1089\1100" && fst z == "\1072" = x:("\1094\1100", Z):z:correctSomeW xs
| fst x == "1" && fst y == "\1081" && fst z == "\1072" =
if takeFromFT 2 xs == "\1095\1085"
then x:y:z:("\1096", Z):correctSomeW (tail xs)
else x:correctSomeW (y:z:xs)
| fst x == "\1090" && fst y == "\1100" && fst z == "\1089\1100" && not (null xs) && (not . null . fst . head $ xs) =
if (fst . head $ xs) == "\1072"
then ("\1094\1100", Z):("\1094\1100", Z):("\1072", Z):correctSomeW (tail xs)
else x:correctSomeW (y:z:xs)
correctSomeW zs = zs
takeFromFT :: Int -> [(String, Triple)] -> String
takeFromFT n ts | compare n 0 == GT = if null ts
then []
else if compare k n /= LT
then take n ks
else ks ++ takeFromFT (n - length ks) (tail ts)
| otherwise = []
where ks = fst (head ts)
k = length ks
takeFromFT_ :: Int -> [(String, Triple)] -> String
takeFromFT_ n ts = takeFromFT n (map (\(xs, y) -> (filter (/='_') xs, y)) ts)
toVector :: [(String, Triple)] -> V.Vector String
toVector ts = V.fromList . mapI2 (\x -> not . null . fst $ x) fst (\y -> []) $ ts
isUkrainian :: Char -> Bool
isUkrainian y | (y >= '\1040' && y <= '\1065') || (y >= '\1070' && y <= '\1097') = True
| otherwise = getBFst' (False, V.fromList . map (\x -> (x, True)) $ "'-\700\1028\1030\1031\1068\1100\1102\1103\1108\1110\1111\1168\1169\8217") y
nSymbols :: String -> Int
nSymbols xs | null xs = 31416::Int
| otherwise = getBFst' (31416::Int, V.generate 10 (\n -> (n, (10^n + 1)::Int))) (let temp = read xs::Int in if temp <= 9 && temp >= 1
then temp
else error "Please, specify a digit as a command line argument for the program!")