-- |
-- 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 (getBFst')
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)

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 = 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

-- Need testing!! It does not work properly!
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

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