-- |
-- Module      :  Melodics.Ukrainian
-- Copyright   :  (c) OleksandrZhabenko 2019
-- License     :  MIT
--
-- Maintainer  :  olexandr543@yahoo.com
--
-- A program that can be used as a musical instrument synthesizer or for Ukrainian speech synthesis 
-- especially for poets, translators and writers. 
--


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
import Data.List.InnToOut.Basic
import Paths_mmsyn6ukr

{-
-- Inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html
-}

data Triple = Z | O | T
  deriving (Eq,Ord,Show,Read)

takeData :: FilePath -> IO B.ByteString
takeData file = do
  data1 <- B.readFile file
  let dataN = B.drop 44 data1 in return dataN


-- | The function that actually produces a .raw file.
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 ()

-- | The function that converts a written Ukrainian text into the sounding in the program phonetical respesentation. 
-- It is not exact phonetically but you can make for yourself a general imression of the Ukrainian sounding.
convertToProperUkrainian :: String -> V.Vector String
convertToProperUkrainian ys = toVector . correctA . createTuplesByAnalysis . filterUkr $ ys

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) | canChange [y] == O = ("1", Z):createTuplesByAnalysis ys
                                | canChange [y] == T = applyChanges . initialA . groupBy isSimilar . changeJotted . wasFstConverted $ x
                                | otherwise = ([y], Z):createTuplesByAnalysis ys
createTuplesByAnalysis _ = []

canChange :: String -> Triple
canChange ~(x:_) | isSpace x || isControl x = O
                 | getBFst' (False, V.fromList $ zip ['\1075','\1076','\1079','\1078','\1082','\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","\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","\1096\1095","\1081\1091","\1081\1072","\1081\1077","\1081\1110","0"]) u

isConsonant :: Char -> Bool
isConsonant = getBFst' (False, V.fromList $ zip "\1073\1074\1075\1076\1078\1079\1081\1082\1083\1084\1085\1087\1088\1089\1090\1092\1093\1094\1095\1096\1169" (repeat True))

changeJotted :: String -> String
changeJotted (x:y:z:zs) | (not (isNotVowel z)) && (y == '\1081') && (isConsonant x) = x:'\1100':z:changeJotted zs
                        | isConsonant 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

-- in the further ??T functions the last (, T) means that it must be afterwards be separated with the soft sign into two tuples (1 additional function in the composition)
-- need further processing means that there should be additional checks and may be transformations. May be they can be omitted

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) -- need further processing д дж
            | takeFromFT_ 2 t1 === ["\1089\1100","\1094\1100"] = ("\1076\1079\1100", T) -- need further processing д дзь
            | takeFromFT_ 1 t1 === ["\1079","\1089","\1094"] = ("\1076\1079", Z) -- need further processing  д дз             
            | 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) -- need further processing з ш
            | takeFromFT 1 t1  === ["\1089","\1094"] || takeFromFT_ 1 t1 === ["\1082","\1087","\1090","\1092","\1093"] = ("\1089", Z) -- need further processing з с
            | 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)
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 . map 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

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!")