ukrainian-phonetics-basic (empty) → 0.1.0.0
raw patch · 6 files changed
+572/−0 lines, 6 filesdep +basedep +bytestringdep +mmsyn2setup-changed
Dependencies added: base, bytestring, mmsyn2, mmsyn5, vector
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- Languages/Phonetic/Ukrainian/Syllable.hs +202/−0
- Melodics/ByteString/Ukrainian.hs +318/−0
- Setup.hs +2/−0
- ukrainian-phonetics-basic.cabal +25/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for ukrainian-phonetics-basic++## 0.1.0.0 -- 2020-10-21++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020 Oleksandr Zhabenko++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Languages/Phonetic/Ukrainian/Syllable.hs view
@@ -0,0 +1,202 @@+-- |+-- Module : Languages.Phonetic.Ukrainian.Syllable+-- Copyright : (c) OleksandrZhabenko 2020+-- 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+--++{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}++module Languages.Phonetic.Ukrainian.Syllable where++import Prelude hiding (mappend)+import Data.Monoid+import Data.Typeable+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector as VB+import qualified Data.List as L (groupBy)+import Melodics.ByteString.Ukrainian (convertToProperUkrainian)+import CaseBi.Unboxed (getBFst')+import qualified CaseBi as X (getBFst')++-- Inspired by: https://github.com/OleksandrZhabenko/mm1/releases/tag/0.2.0.0++-- CAUTION: Please, do not mix with the show7s functions, they are not interoperable.++data UZPP a b = UZ a b deriving ( Eq, Typeable )++instance (Ord a, Ord b) => Ord (UZPP a b) where+ compare (UZ x1 y1) (UZ x2 y2) =+ case compare x1 x2 of+ EQ -> compare y1 y2+ ~z -> z++data PhoneticType = W | S | O | D | K | L | M | N | E deriving ( Eq, Ord, Typeable )++type UZPP2 = UZPP Char PhoneticType++instance Show (UZPP Char PhoneticType) where+ show (UZ x y)+ | y `notElem` [O,K,M] =+ X.getBFst' ("", VB.fromList [('-'," "),('0'," "),('1'," "),('A',"дз"),('B',"ж"),('C',"й"),('D',"сь"),('E',"ч"),('F',"ш"),('G',"щ"),('L',"\700"),('M',"\8217"),+ ('a',"а"),('b',"б"),('c',"ц"),('d',"д"),('e',"е"),('f',"ф"),('g',"ґ"),('h',"г"),('i',"і"),('j',"дж"),('k',"к"),('l',"л"),('m',"м"),('n',"н"),('o',"о"),('p',"п"),('q',"ь"),+ ('r',"р"),('s',"с"),('t',"т"),('u',"у"),('v',"в"),('w',"ць"),('x',"х"),('y',"и"),('z',"з")]) x+ | otherwise =+ X.getBFst' ("", VB.fromList [('-'," "),('0'," "),('1'," "),('A',"дзь"),('B',"жь"),('E',"чь"),('F',"шь"),('G',"щь"),('b',"бь"),('d',"дь"),('f',"фь"),('g',"ґь"),+ ('h',"гь"),('j',"джь"),('k',"кь"),('l',"ль"),('m',"мь"),('n',"нь"),('p',"пь"),('q',"ь"),('r',"рь"),('t',"ть"),('v',"вь"),('x',"хь"),('z',"зь")]) x++phoneType :: UZPP2 -> PhoneticType+phoneType (UZ _ y) = y+{-# INLINE phoneType #-}++charUkr :: UZPP2 -> Char+charUkr (UZ x _) = x+{-# INLINE charUkr #-}++vec2UZPP2s :: V.Vector Char -> [UZPP2]+vec2UZPP2s v+ | V.null v = []+ | getBFst' (False, V.fromList [('a',True),('e',True),('i',True),('o',True),('u',True),('y',True)]) . V.unsafeHead $ v = UZ (V.unsafeHead v) W:vec2UZPP2s (V.unsafeTail v)+ | V.unsafeHead v == 'D' || V.unsafeHead v == 'w' = UZ (V.unsafeHead v) N:vec2UZPP2s (V.unsafeTail v)+ | ((V.null . V.unsafeTail $ v) || (V.unsafeIndex v 1 /= 'q')) && getBFst' (False, V.fromList [('C',True),('l',True),('m',True),('n',True),('r',True),('v',True)]) (V.unsafeHead v) =+ UZ (V.unsafeHead v) S:vec2UZPP2s (V.unsafeTail v)+ | ((V.null . V.unsafeTail $ v) || (V.unsafeIndex v 1 /= 'q')) &&+ getBFst' (False, V.fromList [('A',True),('B',True),('b',True),('d',True),('g',True),('h',True),('j',True),('z',True)]) (V.unsafeHead v) =+ UZ (V.unsafeHead v) D:vec2UZPP2s (V.unsafeTail v)+ | ((V.null . V.unsafeTail $ v) || (V.unsafeIndex v 1 /= 'q')) = UZ (V.unsafeHead v) L:vec2UZPP2s (V.unsafeTail v)+ | getBFst' (False, V.fromList [('l',True),('m',True),('n',True),('r',True),('v',True)]) (V.unsafeHead v) = UZ (V.unsafeHead v) O:vec2UZPP2s (V.unsafeDrop 2 v)+ | getBFst' (False, V.fromList [('A',True),('B',True),('b',True),('d',True),('g',True),('h',True),('j',True),('z',True)]) (V.unsafeHead v) =+ UZ (V.unsafeHead v) K:vec2UZPP2s (V.unsafeDrop 2 v)+ | otherwise = UZ (V.unsafeHead v) M:vec2UZPP2s (V.unsafeDrop 2 v)++-- | Function-predicate 'isVowel1' checks whether its argument is a vowel representation in the 'UZPP2' format.+isVowel1 :: UZPP2 -> Bool+isVowel1 = (== W) . phoneType+{-# INLINE isVowel1 #-}++-- | Function-predicate 'isVwl' checks whether its argument is a vowel representation in the 'Char' format.+isVwl :: Char -> Bool+isVwl = getBFst' (False, (V.fromList [('a',True),('e',True),('i',True),('o',True),('u',True),('y',True)]))+{-# INLINE isVwl #-}++-- | Function-predicate 'isSonorous1' checks whether its argument is a sonorous consonant representation in the 'UZPP2' format.+isSonorous1 :: UZPP2 -> Bool+isSonorous1 = (`elem` [S,O]) . phoneType+{-# INLINE isSonorous1 #-}++-- | Function-predicate 'isVoicedC1' checks whether its argument is a voiced consonant representation in the 'UZPP2' format.+isVoicedC1 :: UZPP2 -> Bool+isVoicedC1 = (`elem` [D,K]) . phoneType+{-# INLINE isVoicedC1 #-}++-- | Function-predicate 'isVoiceless1' checks whether its argument is a voiceless consonant representation in the 'UZPP2' format.+isVoicelessC1 :: UZPP2 -> Bool+isVoicelessC1 = (`elem` [L,M]) . phoneType+{-# INLINE isVoicelessC1 #-}++-- | Binary function-predicate 'isNotVowel2' checks whether its arguments are both consonant representations in the 'UZPP2' format.+isNotVowel2 :: UZPP2 -> UZPP2 -> Bool+isNotVowel2 x y+ | phoneType x == W || phoneType y == W = False+ | otherwise = True+{-# INLINE isNotVowel2 #-} ++-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).+notEqC :: UZPP2 -> UZPP2 -> Bool+notEqC x y+ | charUkr x == 's' || charUkr x == 'D' =+ case charUkr y of+ 's' -> False+ 'D' -> False+ _ -> True+ | charUkr x == 'w' || charUkr x == 'c' =+ case charUkr y of+ 'w' -> False+ 'c' -> False+ _ -> True+ | otherwise = charUkr x /= charUkr y++-- | Function 'sndGroups' converts a Ukrainian word being a list of 'UZPP2' to the list of phonetically similar (consonants grouped with consonants and each vowel separately)+-- sounds representations in 'UZPP2' format.+sndGroups :: [UZPP2] -> [[UZPP2]]+sndGroups ys@(_:_) = L.groupBy isNotVowel2 ys+sndGroups _ = []++-- | Function 'vecWords' similarly to 'Prelude.words' divides a 'V.Vector' of 'Char' into list of them, each element of which is a Ukrainian word (or its part+-- for dashed and hyphenated words or that ones with an apostrophe).+vecWords :: V.Vector Char -> [V.Vector Char]+vecWords v | V.null v = []+ | V.unsafeHead v == '-' || V.unsafeHead v == '0' || V.unsafeHead v == '1' = vecWords (V.unsafeTail v)+ | otherwise =+ let (v1, v2) = V.break (\x -> x == '-' || x == '0' || x == '1') v+ v3 = snd . V.span (\x -> x == '-' || x == '0' || x == '1') $ v2 in v1:vecWords v3++groupSnds :: [UZPP2] -> [[UZPP2]]+groupSnds = L.groupBy (\x y -> ((== W) . phoneType $ x) == ((== W) . phoneType $ 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 :: [UZPP2] -> ([UZPP2] -> [UZPP2],[UZPP2] -> [UZPP2])+divCnsnts xs@(x:ys@(_:_:_:_))+ | (isSonorous1 x) || (isVoicedC1 x) = ((`mappend` [x]),(ys `mappend`))+ | otherwise = ((id),(xs `mappend`))+divCnsnts xs@(x:ys@(y:zs@(_:_)))+ | isSonorous1 x = ((`mappend` [x]),(ys `mappend`))+ | isSonorous1 y = ((`mappend` [x,y]),(zs `mappend`))+ | otherwise = ((id),(xs `mappend`))+divCnsnts xs@(x:ys@(y:_))+ | ((isSonorous1 x) && (x `notEqC` y)) || ((isVoicedC1 x) && (isVoicelessC1 y)) = ((`mappend` [x]),(ys `mappend`))+ | otherwise = ((id),(xs `mappend`))+divCnsnts xs = ((id),(xs `mappend`))++reSyllableCntnts :: [[UZPP2]] -> [[UZPP2]]+reSyllableCntnts (xs:ys:zs:xss)+ | (/= W) . phoneType . 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++createSyllablesUkr :: String -> [[[UZPP2]]]+createSyllablesUkr = map (reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . convertToProperUkrainian . map (\x -> if x == '-' then ' ' else x)++createSyllablesUkrP :: String -> [[[UZPP2]]]+createSyllablesUkrP = map (map representProlonged . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . convertToProperUkrainian . map (\x -> if x == '-' then ' ' else x)++-- | Function 'representProlonged' converts duplicated consequent in the syllable consonants+-- so that they are represented by just one 'UZPP2'. After applying the function to the list of 'UZPP2' being a syllable all groups of duplicated consequent consonants+-- in every syllable are represented with only one 'UZPP2' respectively.+representProlonged :: [UZPP2] -> [UZPP2]+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++-- | Is inspired by the DobutokO.Sound.DIS5G6G module from @dobutokO2@ package.+-- See: 'https://hackage.haskell.org/package/dobutokO2-0.43.0.0/docs/DobutokO-Sound-DIS5G6G.html'. The 'Float' data are gotten from there.+str2Durat1 :: String -> Float+str2Durat1 = X.getBFst' ((0.153016), VB.fromList [("-", (0.101995)), ("0", (0.051020)), ("1", (0.153016)), ("а", 0.138231), ("б", 0.057143),+ ("в", 0.082268), ("г", 0.076825), ("д", 0.072063), ("дж", 0.048934), ("дз", 0.055601), ("е", 0.093605), ("ж", 0.070658), ("з", 0.056054),+ ("и", 0.099955), ("й", 0.057143), ("к", 0.045351), ("л", 0.064036), ("м", 0.077370), ("н", 0.074240), ("о", 0.116463), ("п", 0.134830),+ ("р", 0.049206), ("с", 0.074603), ("сь", 0.074558), ("т", 0.110658), ("у", 0.109070), ("ф", 0.062268), ("х", 0.077188), ("ц", 0.053061),+ ("ць", 0.089342), ("ч", 0.057596), ("ш", 0.066077), ("ь", 0.020227), ("і", 0.094150), ("ґ", 0.062948)])++uzpp2Durat1 :: UZPP2 -> Float+uzpp2Durat1 = X.getBFst' (0.051020, VB.fromList [(UZ 'A' D, 0.055601), (UZ 'A' K, 0.055601), (UZ 'B' D, 0.070658), (UZ 'B' K, 0.070658), (UZ 'C' S, 0.057143), (UZ 'D' N, 0.074558),+ (UZ 'E' L, 0.057596), (UZ 'E' M, 0.057596), (UZ 'F' L, 0.066077), (UZ 'F' M, 0.066077), (UZ 'a' W, 0.138231), (UZ 'b' D, 0.057143), (UZ 'b' K, 0.057143), (UZ 'c' D, 0.053061),+ (UZ 'd' D, 0.072063), (UZ 'd' K, 0.072063), (UZ 'e' W, 0.093605), (UZ 'f' L, 0.062268), (UZ 'f' M, 0.062268), (UZ 'g' D, 0.062948), (UZ 'g' K, 0.062948), (UZ 'h' D, 0.076825), + (UZ 'h' K, 0.076825), (UZ 'i' W, 0.094150), (UZ 'j' D, 0.048934), (UZ 'j' K, 0.048934), (UZ 'k' L, 0.045351), (UZ 'k' M, 0.045351), (UZ 'l' S, 0.064036), (UZ 'l' O, 0.064036),+ (UZ 'm' S, 0.077370), (UZ 'm' O, 0.077370), (UZ 'n' S, 0.074240), (UZ 'n' O, 0.074240), (UZ 'o' W, 0.116463), (UZ 'p' L, 0.134830), (UZ 'p' M, 0.134830),+ (UZ 'q' E, 0.020227), (UZ 'r' S, 0.049206), (UZ 'r' O, 0.049206), (UZ 's' L, 0.074603), (UZ 't' L, 0.110658), (UZ 't' M, 0.110658), (UZ 'u' W, 0.109070), (UZ 'v' S, 0.082268),+ (UZ 'v' O, 0.082268), (UZ 'w' N, 0.089342), (UZ 'x' L, 0.077188), (UZ 'x' M, 0.077188), (UZ 'y' W, 0.099955), (UZ 'z' D, 0.056054), (UZ 'z' K, 0.056054)])++-- | Returns list of lists, every inner one of which contains approximate durations of the Ukrainian syllables.+syllableDurations :: [[[UZPP2]]] -> [[Float]]+syllableDurations = fmap (fmap (sum . fmap (uzpp2Durat1)))+
+ Melodics/ByteString/Ukrainian.hs view
@@ -0,0 +1,318 @@+-- |+-- Module : Melodics.ByteString.Ukrainian+-- Copyright : (c) OleksandrZhabenko 2019-2020+-- 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.Ukrainian from the+-- @mmsyn6ukr@ package : 'https://hackage.haskell.org/package/mmsyn6ukr'+-- 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++{-# LANGUAGE OverloadedStrings #-}++module Melodics.ByteString.Ukrainian (+ convertToProperUkrainian+ , convertToProperUkrainianB+ , isUkrainianL+ , linkFileName+ , showInteresting+) where++import qualified Data.String as S+import Data.Maybe (fromJust)+import Data.Char+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector as VB+import qualified Data.ByteString.Char8 as B+import CaseBi.Unboxed (getBFst')+import qualified CaseBi as X (getBFst')+import Data.List.InnToOut.Basic (mapI)++{-+-- Inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html+-}++data Triple = Z | O | T+ deriving (Eq,Ord,Show)++-- | 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 impression of the Ukrainian sounding.+convertToProperUkrainian :: String -> V.Vector Char+convertToProperUkrainian ys = toVector . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv . filterUkr . changeJotted .+ filter (\x -> isUkrainianL x || isSpace x || isControl x || isPunctuation x) . map toLower $ ys++isUkrainianL :: Char -> Bool+isUkrainianL y | (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+{-# INLINE isUkrainianL #-}++changeJotted :: String -> String+changeJotted (x:y:zs)+ | (y `elem` ("\1102\1103\1108\1110"::String)) && isConsNotJ x = x:'\1100':(case y of+ '\1102' -> '\1091'+ '\1103' -> '\1072'+ '\1108' -> '\1077'+ _ -> '\1110'):changeJotted zs+ | otherwise = x:changeJotted (y:zs)+changeJotted xs = xs++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\\1097\1169" (repeat True))++filterUkr :: String -> B.ByteString +filterUkr = B.pack . map toBSUkr ++toBSUkr :: Char -> Char+toBSUkr x = getBFst' (x, V.fromList . 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" $ "LabvhdeBzyCklmnoprstufxcEFGqHIJiKgM") x++secondConv :: B.ByteString -> B.ByteString+secondConv = B.concatMap f+ where f y+ | isSpace y || isControl y = B.singleton '1'+ | otherwise = X.getBFst' (B.singleton y, VB.fromList $ zip "'-GHIJKLM" [B.singleton '0',B.singleton '0',"FE","Cu","Ca","Ce","Ci",B.singleton '0',B.singleton '0']) y+{-# INLINE secondConv #-}++createTuplesByAnalysis :: B.ByteString -> [(B.ByteString, Triple)]+createTuplesByAnalysis x+ | B.null x = []+ | getBFst' (False, V.fromList $ zip "BEFcdfhknpstxz" (repeat True)) . B.head $ x = initialA x+ | not (B.null . B.tail $ x) && (B.index x 1 == 'C' && isConsNotJ (B.head x)) = (B.copy . B.singleton . B.head $ x, T):(B.singleton 'q', Z):createTuplesByAnalysis (B.drop 2 x)+ | otherwise = (B.copy . B.singleton . B.head $ x, Z):createTuplesByAnalysis (B.tail x)+++initialA :: B.ByteString -> [(B.ByteString, Triple)]+initialA t1+ | B.null t1 = []+ | canChange t == O = (B.singleton '1', Z):initialA ts+ | canChange t == Z = (B.singleton t, Z):initialA ts+ | getBFst' (False, V.fromList $ zip "cdnstx" (repeat True)) t = + let (us,vs) = B.splitAt 2 t1 in + if X.getBFst' (False, VB.fromList $ zip ["cq","dB","dz","nt","sq","st","tq","ts","xh"] (repeat True)) us+ then (B.copy us, T):initialA vs+ else (B.singleton t, T):initialA ts+ | otherwise = case getBFst' (False, V.fromList . zip "BEFfhkpz" . repeat $ True) t of+ ~True -> (B.singleton t, T):initialA ts+ where (t,ts) = fromJust . B.uncons $ t1+++canChange :: Char -> Triple+canChange x+ | isSpace x || isControl x || x == '-' = O+ | getBFst' (False, V.fromList $ zip "BEFcdfhknpstxz" (repeat True)) x = T+ | otherwise = Z+{-# INLINE canChange #-}++bsToCharUkr :: [(B.ByteString,Triple)] -> [(Char,Triple)]+bsToCharUkr = map (\(xs,y) -> (X.getBFst' (B.head xs, VB.fromList . zip ["cq","dB","dz","nt","sq","st","tq","ts","xh"] $ "wjANDOPch") xs,y))+++applyChanges :: [(Char, Triple)] -> [(Char, Triple)]+applyChanges [] = []+applyChanges [(x, _)] = [(x, Z)]+applyChanges xs+ | snd z == T = + X.getBFst' ((fst z, Z), VB.fromList . zip "ABDEFNOPcdfhkpstwxz" $+ [дз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 zs+ | otherwise = z:applyChanges zs+ where z = head xs+ zs = tail xs+++isVoicedObstruent :: Char -> Bool+isVoicedObstruent = getBFst' (False, V.fromList $ zip "ABbdghjz" (repeat True))++isSoftDOrL :: [(Char, Triple)] -> Bool+isSoftDOrL = X.getBFst' (False, VB.fromList . zip ["bq","cq","dq","fq","lq","mq","nq","pq","sq","tq","vq"] $ (repeat True)) . takeFromFT_ 2++isSoftDen :: [(Char, Triple)] -> Bool+isSoftDen = X.getBFst' (False, VB.fromList . zip ["Aq","cq","dq","lq","nq","sq","tq","zq"] $ (repeat True)) . takeFromFT_ 2 ++-- 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++гT :: [(Char, Triple)] -> (Char, Triple)+гT (t:_) | fst t == 'k' || fst t == 't' = ('x', Z)+ | otherwise = ('h', Z)+гT _ = ('h', Z)++дT :: [(Char, Triple)] -> (Char, Triple)+дT t1@(_:_) | takeFromFT_ 1 t1 `elem` ["B","E","F"] = ('j', Z) -- need further processing д дж+ | takeFromFT_ 2 t1 `elem` ["sq","cq"] = ('Q', T) -- need further processing д дзь+ | takeFromFT_ 1 t1 `elem` ["D","w"] = ('Q', T) -- need further processing д дзь + | takeFromFT_ 1 t1 `elem` ["z","s","c"] = ('A', Z) -- need further processing д дз + | otherwise = ('d', Z)+дT _ = ('d', Z)++дзT :: [(Char, Triple)] -> (Char, Triple)+дзT t1@(_:_) | isSoftDOrL t1 = ('Q', T)+ | otherwise = ('A', Z)+дзT _ = ('A', Z)++жT :: [(Char, Triple)] -> (Char, Triple)+жT t1@(_:_) | takeFromFT 2 t1 `elem` ["sq","cq"] = ('R', T)+ | takeFromFT 1 t1 `elem` ["D","w"] = ('R', T)+ | otherwise = ('B', Z)+жT _ = ('B', Z)++зT :: [(Char, Triple)] -> (Char, Triple)+зT t1@(_:_) | takeFromFT_ 1 t1 `elem` ["B","E","F"] || takeFromFT_ 2 t1 == "dB" || takeFromFT_ 1 t1 == "j" = ('B', Z) + | isSoftDOrL t1 = ('R', T)+ | takeFromFT 1 t1 `elem` ["E","F"] = ('F', Z) -- need further processing з ш+ | takeFromFT 1 t1 `elem` ["s","c"] || takeFromFT_ 1 t1 `elem` ["k","p","t","f","x"] = ('s', Z) -- need further processing з с+ | otherwise = ('z', Z)+зT _ = ('z', Z)++кT :: [(Char, Triple)] -> (Char, Triple)+кT t1@(_:_) | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('g', Z)+ | otherwise = ('k', Z)+кT _ = ('k', Z)++нтT :: [(Char, Triple)] -> (Char, Triple)+нтT t1@(_:_) | takeFromFT 2 t1 == "st" || takeFromFT 1 t1 == "O" = ('n', Z)+ | takeFromFT 3 t1 == "sqk" || takeFromFT 2 t1 == "Dk" = ('S', T)+ | otherwise = ('N', Z)+нтT _ = ('N', T)++пT :: [(Char, Triple)] -> (Char, Triple)+пT t1@(_:_) | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('b', Z)+ | otherwise = ('p', Z)+пT _ = ('p', Z)++сT :: [(Char, Triple)] -> (Char, Triple)+сT t1@(_:_) | ((isVoicedObstruent . B.head . takeFromFT_ 1 $ t1) && B.drop 1 (takeFromFT_ 2 t1) == "q") = ('R', T)+ | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('b', Z)+ | isSoftDOrL t1 = ('D', Z)+ | takeFromFT_ 1 t1 == "F" = ('F', Z)+ | otherwise = ('s', Z)+сT _ = ('s', Z)++стT :: [(Char, Triple)] -> (Char, Triple)+стT t1@(_:_) | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('z', Z)+ | takeFromFT_ 3 t1 == "sqk" || (takeFromFT_ 2 t1 `elem` ["Dk","cq"]) || takeFromFT_ 1 t1 == "w" = ('D', Z)+ | takeFromFT_ 1 t1 `elem` ["s","n"] = ('s', Z)+ | takeFromFT_ 1 t1 == "E" = ('F', Z)+ | otherwise = ('O', T)+стT _ = ('O', T)++сьT :: [(Char, Triple)] -> (Char, Triple)+сьT t1@(_:_) | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('R', T)+ | otherwise = ('D', Z)+сьT _ = ('D', Z)++тT :: [(Char, Triple)] -> (Char, Triple)+тT t1@(_:_) | (isVoicedObstruent . B.head . takeFromFT_ 1 $ t1) && B.drop 1 (takeFromFT_ 2 t1) == "q" = ('T', T)+ | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('d', Z)+ | takeFromFT_ 2 t1 == "cq" || takeFromFT_ 1 t1 == "w" = ('w', Z)+ | takeFromFT_ 1 t1 == "c" = ('c', Z)+ | isSoftDen t1 = ('P', T)+ | takeFromFT_ 1 t1 `elem` ["E","F"] = ('E', Z)+ | otherwise = ('t', Z)+тT _ = ('t', Z)++тьT :: [(Char, Triple)] -> (Char, Triple)+тьT t1@(_:_) | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('T', T)+ | takeFromFT_ 3 t1 == "sqa" || takeFromFT_ 2 t1 == "Da" = ('w', Z)+ | otherwise = ('P', T)+тьT _ = ('P', T)++фT :: [(Char, Triple)] -> (Char, Triple)+фT t1@(_:_) | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('v', Z)+ | otherwise = ('f', Z)+фT _ = ('f', Z)++хT :: [(Char, Triple)] -> (Char, Triple)+хT t1@(_:_) | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('h', Z)+ | otherwise = ('x', Z)+хT _ = ('х', Z)++цT :: [(Char, Triple)] -> (Char, Triple)+цT t1@(_:_) | (isVoicedObstruent . B.head . takeFromFT_ 1 $ t1) && B.drop 1 (takeFromFT_ 2 t1) == "q" = ('Q', T)+ | isSoftDOrL t1 = ('w', Z)+ | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('A', Z)+ | otherwise = ('c', Z)+цT _ = ('c', Z)++цьT :: [(Char, Triple)] -> (Char, Triple)+цьT t1@(_:_) | (isVoicedObstruent . B.head . takeFromFT_ 1 $ t1) && B.drop 1 (takeFromFT_ 2 t1) == "q" = ('Q', T)+ | otherwise = ('w', Z)+цьT _ = ('w', Z)++чT :: [(Char, Triple)] -> (Char, Triple)+чT t1@(_:_) | takeFromFT_ 2 t1 `elem` ["sq","cq"] || takeFromFT_ 1 t1 `elem` ["D","w"] = ('w', Z)+ | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('j', Z)+ | otherwise = ('E', Z)+чT _ = ('E', Z)++шT :: [(Char, Triple)] -> (Char, Triple)+шT t1@(_:_) | takeFromFT_ 2 t1 `elem` ["sq","cq"] || takeFromFT_ 1 t1 `elem` ["D","w"] = ('D', Z)+ | isVoicedObstruent . B.head . takeFromFT_ 1 $ t1 = ('B', Z)+ | otherwise = ('F', Z)+шT _ = ('F', Z)++takeFromFT :: Int -> [(Char, Triple)] -> B.ByteString+takeFromFT n ts | if compare 0 n /= LT then True else null ts = B.empty+ | compare 1 n /= LT = B.singleton k+ | otherwise = k `B.cons` takeFromFT (n - 1) (take (n - 1) ts)+ where k = fst (head ts)++takeFromFT2 :: Int -> [Char] -> [Char]+takeFromFT2 n ts | if compare 0 n /= LT then True else null ts = []+ | compare 1 n /= LT = [ks]+ | otherwise = ks:takeFromFT2 (n - 1) (tail ts)+ where ks = head ts++dropFromFT2 :: Int -> [Char] -> [Char]+dropFromFT2 n ts | if compare 0 n /= LT then True else null ts = []+ | compare 1 n /= LT = tail ts+ | otherwise = dropFromFT2 (n - 1) (tail ts)++takeFromFT_ :: Int -> [(Char, Triple)] -> B.ByteString+takeFromFT_ n = takeFromFT n . filter (\(x, _) -> x /= '1' && x /= '0')+{-#INLINE takeFromFT_ #-}++correctA :: [(Char, Triple)] -> [Char]+correctA = correctSomeW . separateSoftS+{-# INLINE correctA #-}++separateSoftS :: [(Char, Triple)] -> [Char]+separateSoftS = map fst . mapI (\x -> snd x == T) divideToParts+{-# INLINE separateSoftS #-}++correctSomeW :: [Char] -> [Char]+correctSomeW (x:y:z:xs) | x == 'w' && y == 'D' && z == 'a' = x:'w':z:correctSomeW xs+ | (x == '1' || x == '0') && y == 'C' && z == 'a' = + if take 2 xs == "En"+ then x:y:z:'F':correctSomeW (tail xs)+ else x:correctSomeW (y:z:xs)+ | otherwise = x:correctSomeW (y:z:xs)+correctSomeW zs = zs++divideToParts :: (Char, Triple) -> [(Char, Triple)]+divideToParts (x, z) = X.getBFst' ([(x, z)], VB.fromList . zip "NOPQRST" $+ [[('n', Z), ('t', Z)], [('s', Z), ('t', Z)], [('t', Z), ('q', Z)], [('A', Z), ('q', Z)], [('z', Z), ('q', Z)], [('n', Z), ('q', Z)], [('d', Z), ('q', Z)]]) . fst $ (x, z)+{-# INLINE divideToParts #-}++toVector :: [Char] -> V.Vector Char+toVector ts = V.fromList . correctB $ ts+{-# INLINE toVector #-}++correctB :: [Char] -> [Char]+correctB ys@(x:xs)+ | compare (length . filter (== '1') . takeFromFT2 6 $ ys) 1 == GT = map (\t -> if t == '1' || isPunctuation t then '-' else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys)+ | otherwise = (if isPunctuation x then '-' else x):correctB xs+correctB _ = []++-- | A variant of the 'convertToProperUkrainian' with the 'B.ByteString' result.+convertToProperUkrainianB :: String -> B.ByteString+convertToProperUkrainianB ys = B.pack . correctB . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv . filterUkr . changeJotted .+ filter (\x -> isUkrainianL x || isSpace x || isControl x || isPunctuation x) . map toLower $ ys++linkFileName :: Char -> Char+linkFileName x = getBFst' (x,V.fromList . zip "ABCDEFLMabcdefghijklmnopqrstuvwxyz" $ "GILUbc00ABZEHXfDeFMNOPQRdSTVWCaYKJ") x++showInteresting :: String -> B.ByteString+showInteresting = S.fromString . V.toList . convertToProperUkrainian
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ukrainian-phonetics-basic.cabal view
@@ -0,0 +1,25 @@+-- Initial ukrainian-phonetics-basic.cabal generated by cabal init. For+-- further documentation, see http://haskell.org/cabal/users-guide/++name: ukrainian-phonetics-basic+version: 0.1.0.0+synopsis: A library to work with the basic Ukrainian phonetics and syllable segmentation.+description: A library to work with the basic Ukrainian phonetics and syllable segmentation. Rewritten from the mmsyn6ukr and mmsyn7s packages.+homepage: https://hackage.haskell.org/package/ukrainian-phonetics-basic+license: MIT+license-file: LICENSE+author: OleksandrZhabenko+maintainer: olexandr543@yahoo.com+copyright: Oleksandr Zhabenko+category: Language+build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.10++library+ exposed-modules: Languages.Phonetic.Ukrainian.Syllable, Melodics.ByteString.Ukrainian+ -- other-modules:+ other-extensions: DeriveDataTypeable, FlexibleInstances, OverloadedStrings+ build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14, mmsyn2 >=0.2 && <1, bytestring >=0.10 && <0.13, mmsyn5 >=0.4.4 && <1+ -- hs-source-dirs:+ default-language: Haskell2010