{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, BangPatterns #-}
-- |
-- Module : Languages.Phonetic.Ukrainian.Syllable.ArrInt8
-- Copyright : (c) OleksandrZhabenko 2021-2022
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- This module works with syllable segmentation in Ukrainian. It is rewritten
-- module MMSyn7.Syllable from the @mmsyn7s@ package : https://hackage.haskell.org/package/mmsyn7s
-- The information on Ukrainian syllable segmentation is taken from the:
-- https://msn.khnu.km.ua/pluginfile.php/302375/mod_resource/content/1/%D0%9B.3.%D0%86%D0%86.%20%D0%A1%D0%BA%D0%BB%D0%B0%D0%B4.%D0%9D%D0%B0%D0%B3%D0%BE%D0%BB%D0%BE%D1%81.pdf
--
module Languages.Phonetic.Ukrainian.Syllable.ArrInt8 (
-- * Basic functionality
isVowel1
, isSonorous1
, isVoicedC1
, isVoicelessC1
, isNotVowel2
, sndGroups
, groupSnds
, divCnsnts
, reSyllableCntnts
, divVwls
, createSyllablesUkrS
, notEqC
, representProlonged
-- * With additional data used (probably for speed up)
, notEqCTup
, divCnsntsTup
, reSyllableCntntsTup
, createSyllablesUkrSTup
) where
import Prelude hiding (mappend)
import GHC.Arr
import Data.Monoid
import Data.Typeable
import qualified Data.List as L (groupBy)
import Melodics.Ukrainian.ArrInt8
import CaseBi.Arr
import GHC.Int
import Data.List.InnToOut.Basic (mapI)
import Data.Maybe (mapMaybe)
-- Inspired by: https://github.com/OleksandrZhabenko/mm1/releases/tag/0.2.0.0
-- | Function-predicate 'isVowel1' checks whether its argument is a vowel representation in the 'Sound8' format.
isVowel1 :: Sound8 -> Bool
isVowel1 x = x > 0 && x < 7
{-# INLINE isVowel1 #-}
-- | Function-predicate 'isSonorous1' checks whether its argument is a sonorous consonant representation in the 'Sound8' format.
isSonorous1 :: Sound8 -> Bool
isSonorous1 x = x > 26 && x < 38
{-# INLINE isSonorous1 #-}
-- | Function-predicate 'isVoicedC1' checks whether its argument is a voiced consonant representation in the 'Sound8' format.
isVoicedC1 :: Sound8 -> Bool
isVoicedC1 x = x > 7 && x < 27
{-# INLINE isVoicedC1 #-}
-- | Function-predicate 'isVoiceless1' checks whether its argument is a voiceless consonant representation in the 'Sound8' format.
isVoicelessC1 :: Sound8 -> Bool
isVoicelessC1 x = x > 37 && x < 54
{-# INLINE isVoicelessC1 #-}
-- | Binary function-predicate 'isNotVowel2' checks whether its arguments are both consonant representations in the 'Sound8' format.
isNotVowel2 :: Sound8 -> Sound8 -> Bool
isNotVowel2 x y = x > 6 && y > 6
{-# INLINE isNotVowel2 #-}
-- | Function 'sndGroups' converts a Ukrainian word being a list of 'Sound8' to the list of phonetically similar (consonants grouped with consonants and each vowel separately)
-- sounds representations in 'Sound8' format.
sndGroups :: FlowSound -> [FlowSound]
sndGroups ys@(_:_) = L.groupBy isNotVowel2 ys
sndGroups _ = []
groupSnds :: FlowSound -> [FlowSound]
groupSnds = L.groupBy (\x y -> isVowel1 x == isVowel1 y)
-- | Function 'divCnsnts' is used to divide groups of Ukrainian consonants into two-elements lists that later are made belonging to
-- different neighbour syllables if the group is between two vowels in a word. The group must be not empty, but this is not checked.
-- The phonetical information for the proper performance is taken from the:
-- https://msn.khnu.km.ua/pluginfile.php/302375/mod_resource/content/1/%D0%9B.3.%D0%86%D0%86.%20%D0%A1%D0%BA%D0%BB%D0%B0%D0%B4.%D0%9D%D0%B0%D0%B3%D0%BE%D0%BB%D0%BE%D1%81.pdf
divCnsnts :: FlowSound -> (FlowSound -> FlowSound,FlowSound -> FlowSound)
divCnsnts xs@(x:ys@(_:_:_:_))
| isSonorous1 x || isVoicedC1 x = ((`mappend` [x]),mappend ys)
| otherwise = (id,mappend xs)
divCnsnts xs@(x:ys@(y:zs@(_:_)))
| isSonorous1 x = ((`mappend` [x]),mappend ys)
| isSonorous1 y = ((`mappend` [x,y]),mappend zs)
| otherwise = (id,mappend xs)
divCnsnts xs@(x:ys@(y:_))
| (isSonorous1 x && (notEqC x y)) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys)
| otherwise = (id,mappend xs)
divCnsnts xs = (id,mappend xs)
-- | Function 'divCnsntsTup' is a variant of the 'divCnsts' where you can provide the tuple element for 'getBFst'' inside.
divCnsntsTup :: Array Int (Int8,Bool) -> FlowSound -> (FlowSound -> FlowSound,FlowSound -> FlowSound)
divCnsntsTup !tup17 xs@(x:ys@(_:_:_:_))
| isSonorous1 x || isVoicedC1 x = ((`mappend` [x]),mappend ys)
| otherwise = (id,mappend xs)
divCnsntsTup !tup17 xs@(x:ys@(y:zs@(_:_)))
| isSonorous1 x = ((`mappend` [x]),mappend ys)
| isSonorous1 y = ((`mappend` [x,y]),mappend zs)
| otherwise = (id,mappend xs)
divCnsntsTup !tup17 xs@(x:ys@(y:_))
| (isSonorous1 x && (notEqCTup tup17 x y)) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys)
| otherwise = (id,mappend xs)
divCnsntsTup _ xs = (id,mappend xs)
reSyllableCntntsTup :: Array Int (Int8,Bool) -> [FlowSound] -> [FlowSound]
reSyllableCntntsTup !tup17 (xs:ys:zs:xss)
| (> 6) . last $ ys = fst (divCnsntsTup tup17 ys) xs:reSyllableCntntsTup tup17 (snd (divCnsntsTup tup17 ys) zs:xss)
| otherwise = reSyllableCntntsTup tup17 ((xs `mappend` ys):zs:xss)
reSyllableCntntsTup !tup17 (xs:ys:_) = [xs `mappend` ys]
reSyllableCntntsTup !tup17 xss = xss
reSyllableCntnts :: [FlowSound] -> [FlowSound]
reSyllableCntnts (xs:ys:zs:xss)
| (> 6) . last $ ys = fst (divCnsnts ys) xs:reSyllableCntnts (snd (divCnsnts ys) zs:xss)
| otherwise = reSyllableCntnts ((xs `mappend` ys):zs:xss)
reSyllableCntnts (xs:ys:_) = [xs `mappend` ys]
reSyllableCntnts xss = xss
divVwls :: [FlowSound] -> [FlowSound]
divVwls = mapI (\ws -> (length . filter isVowel1 $ ws) > 1) h3
where h3 us = [ys `mappend` take 1 zs] `mappend` (L.groupBy (\x y -> isVowel1 x && y > 6) . drop 1 $ zs)
where (ys,zs) = span (>6) us
createSyllablesUkrS :: String -> [[FlowSound]]
createSyllablesUkrS = map (divVwls . reSyllableCntnts . groupSnds) . words1 . convertToProperUkrainianI8 .
map (\x -> if x == '-' then ' ' else x)
where words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
where ts = dropWhile (< 1) xs
(w, s'') = span (> 0) ts
{-# NOINLINE words1 #-}
{-# INLINE createSyllablesUkrS #-}
createSyllablesUkrSTup
:: Array Int (Int8, Bool)
-> Array Int (Int8, Bool)
-> Array Int (Int8, Bool)
-> Array Int (Int8, Bool)
-> Array Int ([Int8], Bool)
-> Array Int ([Int8], Int8)
-> Array Int (Int8, FlowSound -> Sound8)
-> Array Int (Int8, Bool)
-> Array Int ([Int8], Bool)
-> Array Int ([Int8], Bool)
-> Array Int ([Int8], Bool)
-> Array Int (Int8, [Int8])
-> Array Int (Char,Int8)
-> Array Int (Int8,[Int8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Int8,Bool)
-> String
-> [[FlowSound]]
createSyllablesUkrSTup !tup1 !tup2 !tup3 !tup4 !tup5 !tup6 !tup7 !tup8 !tup9 !tup10 !tup11 !tup12 !tup13 !tup14 !tup15 !tup16 !tup17 =
map (divVwls . reSyllableCntntsTup tup17 . groupSnds) . words1 .
convertToProperUkrainianI8WithTuples tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 .
map (\x -> if x == '-' then ' ' else x)
where words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
where ts = dropWhile (< 1) xs
(w, s'') = span (> 0) ts
{-# NOINLINE words1 #-}
{-# INLINE createSyllablesUkrSTup #-}
-----------------------------------------------------
-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).
notEqC :: Sound8 -> Sound8 -> Bool
notEqC x y
| x == 49 || x == 54 =
case y of
49 -> False
54 -> False
_ -> True
| x == 66 || x == 38 =
case y of
38 -> False
66 -> False
_ -> True
| x == y = False
| abs (x - y) == 1 =
getBFstLSorted' True ([(8,False),(10,False),(15,False),(17,False),(19,False),(21,False),(23,False),(25,False),
(28,False),(30,False),(32,False),(34,False),(36,False),(39,False),(41,False),(43,False),(45,False),(47,False),
(50,False),(52,False)]) . min x $ y
| otherwise = True
-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).
notEqCTup :: Array Int (Int8,Bool) -> Sound8 -> Sound8 -> Bool
notEqCTup !tup17 x y
| x == 49 || x == 54 =
case y of
49 -> False
54 -> False
_ -> True
| x == 66 || x == 38 =
case y of
38 -> False
66 -> False
_ -> True
| x == y = False
| abs (x - y) == 1 = getBFst' (True, tup17) . min x $ y
| otherwise = True
-- | Function 'representProlonged' converts duplicated consequent in the syllable consonants
-- so that they are represented by just one 'Sound8'. After applying the function to the list of 'Sound8' being a syllable all groups of duplicated consequent consonants
-- in every syllable are represented with only one 'Sound8' respectively.
representProlonged :: FlowSound -> FlowSound
representProlonged (x:y:xs)
| isVowel1 x = x:representProlonged (y:xs)
| not . notEqC x $ y = y:representProlonged xs
| otherwise = x:representProlonged (y:xs)
representProlonged xs = xs