{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Melodics.ByteString.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.ByteString.Ukrainian.ArrInt8 (
  -- * Basic functions
  Sound8
  , FlowSound
  , convertToProperUkrainianI8
  , isUkrainianL
  , linkFileNameI8
) where

import qualified Data.String as S
import Data.Maybe (fromJust)
import Data.Char
import GHC.Arr
import CaseBi.Arr
import Data.List (uncons)
import GHC.Int
import Melodics.ByteString.Ukrainian.Common

type Sound8 = Int8

type FlowSound = [Sound8]

convertToProperUkrainianI8 :: String -> FlowSound
convertToProperUkrainianI8 = correctB . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv .
  filterUkr . changeIotated . filter (\x -> isUkrainianL x || isSpace x || isControl x || isPunctuation x) . map toLower
{-# INLINE convertToProperUkrainianI8 #-}

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
{-# INLINE filterUkr #-}

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])
{-# INLINE toBSUkr #-}

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)
{-# INLINE secondConv #-}

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))
{-# INLINE isConsNotJ8 #-}

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
{-# INLINE bsToCharUkr #-}

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
{-# INLINE applyChanges #-}

isVoicedObstruent :: FlowSound -> Bool
isVoicedObstruent xs
 | null xs = False
 | otherwise = (\u -> u > 7 && u < 27) . head $ xs
{-# INLINE isVoicedObstruent #-}

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
{-# INLINE isVoicedObstruentH #-}

isVoicedObstruentS :: FlowSound -> Bool
isVoicedObstruentS xs
 | null xs = False
 | otherwise = (\u -> u > 11 && u < 15) . head $ xs
{-# INLINE isVoicedObstruentS #-}

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)
{-# INLINE isSoftDOrL #-}

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)
{-# INLINE isSoftDen #-}

гT :: FlowSound -> Sound8
гT (t:_) | t == 45 || t == 50 = 52
         | otherwise = 21
гT _ = 21
{-# INLINE гT #-}

д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
{-# INLINE дT #-}

дзT :: FlowSound -> Sound8
дзT t1@(_:_) | isSoftDOrL t1 = 12
             | otherwise = 8
дзT _ = 8
{-# INLINE дзT #-}

ж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
{-# INLINE жT #-}

з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
{-# INLINE зT #-}

кT :: FlowSound -> Sound8
кT t1@(_:_) | isVoicedObstruent .  takeFromFT_ 1 $ t1 = 19
            | otherwise = 45
кT _ = 45
{-# INLINE кT #-}

нт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
{-# INLINE нтT #-}

пT :: FlowSound -> Sound8
пT t1@(_:_) | isVoicedObstruent .  takeFromFT_ 1 $ t1 = 15
            | otherwise = 47
пT _ = 47
{-# INLINE пT #-}

с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
{-# INLINE сT #-}

ст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
{-# INLINE стT #-}

сьT :: FlowSound -> Sound8
сьT t1@(_:_) | isVoicedObstruent .  takeFromFT_ 1 $ t1 = 13
             | otherwise = 54
сьT _ = 54
{-# INLINE сьT #-}

т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
{-# INLINE тT #-}

ть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
{-# INLINE тьT #-}

фT :: FlowSound -> Sound8
фT t1@(_:_) | isVoicedObstruent .  takeFromFT_ 1 $ t1 = 36
            | otherwise = 43
фT _ = 43
{-# INLINE фT #-}

хT :: FlowSound -> Sound8
хT t1@(_:_) | isVoicedObstruent .  takeFromFT_ 1 $ t1 = 21
            | otherwise = 52
хT _ = 52
{-# INLINE хT #-}

ц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
{-# INLINE цT #-}

цьT :: FlowSound -> Sound8
цьT t1@(_:_) | (isVoicedObstruent .  takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7] = 12
             | otherwise = 66
цьT _ = 66
{-# INLINE цьT #-}

ч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
{-# INLINE чT #-}

ш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
{-# INLINE шT #-}

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)
{-# INLINE takeFromFT_ #-}

correctA :: FlowSound -> FlowSound
correctA = correctSomeW . separateSoftS
{-# INLINE correctA #-}

separateSoftS :: FlowSound -> FlowSound
separateSoftS = concatMap divideToParts
{-# INLINE separateSoftS #-}

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
{-# INLINE divideToParts #-}

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 _ = []

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
{-# INLINE linkFileNameI8 #-}