module Melodics.Ukrainian (
appendS16LEFile,
convertToProperUkrainian,
takeData
) where
import Data.Char
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy as B
import System.IO
import CaseBi (getBFst')
import Data.List.InnToOut.Basic (mapI, mapI2)
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
["-.wav", "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), ("ґ", 34)]) 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 = toVector . correctA . applyChanges . createTuplesByAnalysis . changeJotted . secondConv . wasFstConverted . filterUkr $ ys
correctB :: [String] -> [String]
correctB ys@(xs:xss) | compare (length . filter (== "1") . takeFromFT2 6 $ ys) 1 == GT =
map (\t -> if t == "1" || isPunctuation (head t) then "-" else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys)
| otherwise = (if isPunctuation . head $ xs then "-" else xs):correctB xss
correctB [] = []
filterUkr :: String -> String
filterUkr xs = concatMap (\x -> if isUkrainian x then [toLower x] else if isSpace x || isControl x || isPunctuation x then [x] else []) xs
secondConv :: String -> String
secondConv (y:ys) | if isSpace y then True else isControl y = '1':secondConv ys
| otherwise = y:secondConv ys
secondConv _ = []
createTuplesByAnalysis :: String -> [(String, Triple)]
createTuplesByAnalysis x@(y:ys) | getBFst' (False, V.fromList $ zip "\1075\1076\1078\1079\1082\1085\1087\1089\1090\1092\1093\1094\1095\1096" (repeat True)) y = initialA x
| 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 :: Char -> 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 t1@(t:ts) | canChange t == O = ("1", Z):initialA ts
| canChange t == T =
if getBFst' (False, V.fromList $ zip "\1076\1085\1089\1090\1093\1094" (repeat True)) t
then let (us,vs) = splitAt 2 t1 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)
else ([t], T):initialA ts
else case (getBFst' (False, V.fromList $ zip "\1075\1078\1079\1082\1087\1092\1095\1096" (repeat True)) t) of
~True -> ([t], T):initialA ts
| otherwise = ([t], Z):initialA ts
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
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 (t:zs), дT (t:zs), дзT (t:zs), жT (t:zs), зT (t:zs), кT (t:zs),
нтT (t:zs), пT (t:zs), сT (t:zs), стT (t:zs), сьT (t:zs), тT (t:zs), тсT (t:zs), тьT (t:zs),
фT (t:zs), хT (t:zs), хгT (t:zs), цT (t:zs), цьT (t:zs), чT (t:zs), шT (t:zs)]) (fst z):applyChanges (t:zs)
| otherwise = z:applyChanges (t:zs)
applyChanges [(xs, _)] = [(xs, Z)]
applyChanges _ = []
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 `elem` ["\1078","\1095","\1096"] = ("\1076\1078", Z)
| takeFromFT_ 2 t1 `elem` ["\1089\1100","\1094\1100"] = ("\1076\1079\1100", T)
| takeFromFT_ 1 t1 `elem` ["\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 `elem` ["\1089\1100","\1094\1100"] = ("\1079\1100", T)
| otherwise = ("\1078", Z)
жT _ = ("ж", Z)
зT :: [(String, Triple)] -> (String, Triple)
зT t1@(_:_) | takeFromFT_ 1 t1 `elem` ["\1078","\1095","\1096"] || takeFromFT_ 2 t1 == "\1076\1078" = ("\1078", Z)
| isSoftDOrL t1 = ("\1079\1100", T)
| takeFromFT 1 t1 `elem` ["\1095","\1096"] = ("\1096", Z)
| takeFromFT 1 t1 `elem` ["\1089","\1094"] || takeFromFT_ 1 t1 `elem` ["\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 `elem` ["\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 `elem` ["\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 `elem` ["\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 `elem` ["\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 xss = mapI (\x -> snd x == T) divideToParts xss
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 x == "0") && 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)
| otherwise = x:correctSomeW (y:z:xs)
correctSomeW zs = zs
takeFromFT :: Int -> [(String, Triple)] -> String
takeFromFT n ts | if compare 0 n /= LT then True else null ts = []
| compare k n /= LT = take n ks
| otherwise = ks ++ takeFromFT (n - k) (tail ts)
where ks = fst (head ts)
k = length ks
takeFromFT2 :: Int -> [String] -> [String]
takeFromFT2 n ts | if compare 0 n /= LT then True else null ts = []
| compare k n /= LT = [ks]
| otherwise = ks:takeFromFT2 (n - k) (tail ts)
where ks = head ts
k = length ks
dropFromFT2 :: Int -> [String] -> [String]
dropFromFT2 n ts | if compare 0 n /= LT then True else null ts = []
| compare k n /= LT = tail ts
| otherwise = dropFromFT2 (n - k) (tail ts)
where k = length (head ts)
takeFromFT_ :: Int -> [(String, Triple)] -> String
takeFromFT_ n ts = takeFromFT n (filter (\(xs, _) -> (xs /= "1" && xs /= "0")) ts)
toVector :: [(String, Triple)] -> V.Vector String
toVector ts = V.fromList . correctB . mapI2 (\x -> not . null . fst $ x) fst (\_ -> []) $ 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