{-# OPTIONS_HADDOCK show-extensions #-}

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

import Data.Maybe (fromJust)
import Data.Char
import GHC.Arr
import CaseBi.Arr
import Data.List (uncons)
import GHC.Int
import Melodics.Ukrainian.Common

-- | Is used to signify the optimization data type of 'Int8'.
type Sound8 = Int8

type FlowSound = [Sound8]

{-| The function that uses the following correspondence between the previous data type UZPP2 and the 'Sound8'.
@
UZ \'A\' D       дз (plain)                 8
UZ \'A\' K       дз (palatalized)           9
UZ \'B\' D       ж  (plain)                 10
UZ \'B\' K       ж  (semi-palatalized)      11
UZ \'C\' S       й                          27
UZ \'D\' N       сь                         54
UZ \'E\' L       ч  (plain)                 39
UZ \'E\' M       ч  (semi-palatalized)      40
UZ \'F\' L       ш  (plain)                 41
UZ \'F\' M       ш  (semi-palatalized)      42
     G                                      55
     H                                      56
     I                                      57
     J                                      58
     K                                      59
     L                                      60
     M                                      61
     N          нт                          62
     O          ст                          63
     P          ть                          64
     Q          дзь                         12
     R          зь                          13
     S          нь                          65
     T          дь                          14
UZ \'a\' W       а                          1
UZ \'b\' D       б  (plain)                 15
UZ \'b\' K       б  (semi-palatalized)      16
UZ \'c\' D       ц  (plain)                 38
UZ \'d\' D       д  (plain)                 17
UZ \'d\' K       д  (palatalized)           18
UZ \'e\' W       е                          2
UZ \'f\' L       ф  (plain)                 43
UZ \'f\' M       ф  (semi-palatalized)      44
UZ \'g\' D       ґ  (plain)                 19
UZ \'g\' K       ґ  (semi-palatalized)      20
UZ \'h\' D       г  (plain)                 21
UZ \'h\' K       г  (semi-palatalized)      22
UZ \'i\' W       і                          6
UZ \'j\' D       дж (plain)                 23
UZ \'j\' K       дж (palatalized)           24
UZ \'k\' L       к  (plain)                 45
UZ \'k\' M       к  (semi-palatalized)      46
UZ \'l\' S       л  (plain)                 28
UZ \'l\' O       л  (palatalized)           29
UZ \'m\' S       м  (plain)                 30
UZ \'m\' O       м  (semi-palatalized)      31
UZ \'n\' S       н  (plain)                 32
UZ \'n\' O       н  (palatalized)           33
UZ \'o\' W       о                          3
UZ \'p\' L       п  (plain)                 47
UZ \'p\' M       п  (semi-palatalized)      48
UZ \'q\' E       ь                          7
UZ \'r\' S       р  (plain)                 34
UZ \'r\' O       р  (palatalized)           35
UZ \'s\' L       с  (plain)                 49
UZ \'t\' L       т  (plain)                 50
UZ \'t\' M       т  (palatalized)           51
UZ \'u\' W       у                          4
UZ \'v\' S       в  (plain)                 36
UZ \'v\' O       в  (semi-palatalized)      37
UZ \'w\' N       ць                         66
UZ \'x\' L       х  (plain)                 52
UZ \'x\' M       х  (semi-palatalized)      53
UZ \'y\' W       и                          5
UZ \'z\' D       з  (plain)                 25
UZ \'z\' K       з  (palatalized)           26
@
-}
convertToProperUkrainianI8 :: String -> FlowSound
convertToProperUkrainianI8 :: String -> FlowSound
convertToProperUkrainianI8 = FlowSound -> FlowSound
correctB (FlowSound -> FlowSound)
-> (String -> FlowSound) -> String -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> FlowSound
correctA (FlowSound -> FlowSound)
-> (String -> FlowSound) -> String -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> FlowSound
applyChanges (FlowSound -> FlowSound)
-> (String -> FlowSound) -> String -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FlowSound] -> FlowSound
bsToCharUkr ([FlowSound] -> FlowSound)
-> (String -> [FlowSound]) -> String -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> [FlowSound]
createTuplesByAnalysis (FlowSound -> [FlowSound])
-> (String -> FlowSound) -> String -> [FlowSound]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> FlowSound
secondConv (FlowSound -> FlowSound)
-> (String -> FlowSound) -> String -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  String -> FlowSound
filterUkr (String -> FlowSound) -> (String -> String) -> String -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
changeIotated (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Char -> Bool
isUkrainianL Char
x Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
x Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
x) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

changeIotated :: String -> String
changeIotated :: String -> String
changeIotated (Char
x:Char
y:String
zs)
  | (Char
y Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"\1102\1103\1108\1110"::String)) Bool -> Bool -> Bool
&& Char -> Bool
isConsNotJ Char
x = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'\1100'Char -> String -> String
forall a. a -> [a] -> [a]
:(case Char
y of { Char
'\1102' -> Char
'\1091' ; Char
'\1103' -> Char
'\1072' ; Char
'\1108' -> Char
'\1077' ; ~Char
r -> Char
'\1110' })Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
changeIotated String
zs
  | Bool
otherwise = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
changeIotated (Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:String
zs)
changeIotated String
xs = String
xs

filterUkr :: String -> FlowSound
filterUkr :: String -> FlowSound
filterUkr = (Char -> Sound8) -> String -> FlowSound
forall a b. (a -> b) -> [a] -> [b]
map Char -> Sound8
toBSUkr

toBSUkr :: Char -> Sound8
toBSUkr :: Char -> Sound8
toBSUkr = Sound8 -> [(Char, Sound8)] -> Char -> Sound8
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Sound8
0 (String -> FlowSound -> [(Char, Sound8)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"'-\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" [-Sound8
2,-Sound8
1,Sound8
60,Sound8
1,Sound8
15,Sound8
36,Sound8
21,Sound8
17,Sound8
2,Sound8
10,Sound8
25,Sound8
5,Sound8
27,Sound8
45,Sound8
28,Sound8
30,Sound8
32,Sound8
3,Sound8
47,Sound8
34,Sound8
49,Sound8
50,Sound8
4,Sound8
43,Sound8
52,Sound8
38,Sound8
39,Sound8
41,Sound8
55,Sound8
7,Sound8
56,Sound8
57,Sound8
58,Sound8
6,Sound8
59,Sound8
19,Sound8
61])

secondConv :: FlowSound -> FlowSound
secondConv :: FlowSound -> FlowSound
secondConv =
  (Sound8 -> FlowSound) -> FlowSound -> FlowSound
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Sound8
y -> FlowSound -> [(Sound8, FlowSound)] -> Sound8 -> FlowSound
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' [Sound8
y] (FlowSound -> [FlowSound] -> [(Sound8, FlowSound)]
forall a b. [a] -> [b] -> [(a, b)]
zip [-Sound8
2,-Sound8
1,Sound8
55,Sound8
56,Sound8
57,Sound8
58,Sound8
59,Sound8
60,Sound8
61] [[-Sound8
1],[-Sound8
1],[Sound8
41,Sound8
39],[Sound8
27,Sound8
4],[Sound8
27,Sound8
1],[Sound8
27,Sound8
2],[Sound8
27,Sound8
6],[-Sound8
1],[-Sound8
1]]) Sound8
y)

createTuplesByAnalysis :: FlowSound -> [FlowSound]
createTuplesByAnalysis :: FlowSound -> [FlowSound]
createTuplesByAnalysis FlowSound
x
  | FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
x = []
  | Bool -> [(Sound8, Bool)] -> Sound8 -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False (FlowSound -> [Bool] -> [(Sound8, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Sound8
10,Sound8
17,Sound8
21,Sound8
25,Sound8
32,Sound8
38,Sound8
39,Sound8
41,Sound8
43,Sound8
45,Sound8
47,Sound8
49,Sound8
50,Sound8
52] (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)) (Sound8 -> Bool) -> (FlowSound -> Sound8) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> Sound8
forall a. [a] -> a
head (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
x = FlowSound -> [FlowSound]
initialA FlowSound
x
  | Bool -> Bool
not (FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> FlowSound
forall a. [a] -> [a]
tail (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
x) Bool -> Bool -> Bool
&& (FlowSound
x FlowSound -> Int -> Sound8
forall a. [a] -> Int -> a
!! Int
1 Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
27 Bool -> Bool -> Bool
&& Sound8 -> Bool
isConsNotJ8 (FlowSound -> Sound8
forall a. [a] -> a
head FlowSound
x)) = Int -> FlowSound -> FlowSound
forall a. Int -> [a] -> [a]
take Int
1 FlowSound
xFlowSound -> [FlowSound] -> [FlowSound]
forall a. a -> [a] -> [a]
:[Sound8
7]FlowSound -> [FlowSound] -> [FlowSound]
forall a. a -> [a] -> [a]
:FlowSound -> [FlowSound]
createTuplesByAnalysis (Int -> FlowSound -> FlowSound
forall a. Int -> [a] -> [a]
drop Int
2 FlowSound
x)
  | Bool
otherwise = Int -> FlowSound -> FlowSound
forall a. Int -> [a] -> [a]
take Int
1 FlowSound
xFlowSound -> [FlowSound] -> [FlowSound]
forall a. a -> [a] -> [a]
:FlowSound -> [FlowSound]
createTuplesByAnalysis (FlowSound -> FlowSound
forall a. [a] -> [a]
tail FlowSound
x)

isConsNotJ8 :: Int8 -> Bool
isConsNotJ8 :: Sound8 -> Bool
isConsNotJ8 = Bool -> [(Sound8, Bool)] -> Sound8 -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False (FlowSound -> [Bool] -> [(Sound8, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Sound8
10,Sound8
15,Sound8
17,Sound8
19,Sound8
21,Sound8
25,Sound8
28,Sound8
30,Sound8
32,Sound8
34,Sound8
36,Sound8
38,Sound8
39,Sound8
41,Sound8
43,Sound8
45,Sound8
47,Sound8
49,Sound8
50,Sound8
52] (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True))

initialA :: FlowSound -> [FlowSound]
initialA :: FlowSound -> [FlowSound]
initialA t1 :: FlowSound
t1@(Sound8
t:FlowSound
ts)
  | Sound8
t Sound8 -> Sound8 -> Bool
forall a. Ord a => a -> a -> Bool
< Sound8
1 = [Sound8
0]FlowSound -> [FlowSound] -> [FlowSound]
forall a. a -> [a] -> [a]
:FlowSound -> [FlowSound]
initialA FlowSound
ts
  | Bool -> [(Sound8, Bool)] -> Sound8 -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
True (FlowSound -> [Bool] -> [(Sound8, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Sound8
10,Sound8
17,Sound8
21,Sound8
25,Sound8
32,Sound8
38,Sound8
39,Sound8
41,Sound8
43,Sound8
45,Sound8
47,Sound8
49,Sound8
50,Sound8
52] (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)) Sound8
t = [Sound8
t]FlowSound -> [FlowSound] -> [FlowSound]
forall a. a -> [a] -> [a]
:FlowSound -> [FlowSound]
initialA FlowSound
ts
  | Bool -> [(Sound8, Bool)] -> Sound8 -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False (FlowSound -> [Bool] -> [(Sound8, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Sound8
17,Sound8
32,Sound8
38,Sound8
49,Sound8
50,Sound8
52] (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)) Sound8
t =
     let (FlowSound
us,FlowSound
vs) = Int -> FlowSound -> (FlowSound, FlowSound)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 FlowSound
t1 in
       if Bool -> [(FlowSound, Bool)] -> FlowSound -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([FlowSound] -> [Bool] -> [(FlowSound, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Sound8
17,Sound8
10],[Sound8
17,Sound8
25],[Sound8
32,Sound8
50],[Sound8
38,Sound8
7],[Sound8
49,Sound8
7],[Sound8
49,Sound8
50],[Sound8
50,Sound8
7],[Sound8
50,Sound8
49],[Sound8
52,Sound8
21]] (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)) FlowSound
us
        then FlowSound
usFlowSound -> [FlowSound] -> [FlowSound]
forall a. a -> [a] -> [a]
:FlowSound -> [FlowSound]
initialA FlowSound
vs
        else [Sound8
t]FlowSound -> [FlowSound] -> [FlowSound]
forall a. a -> [a] -> [a]
:FlowSound -> [FlowSound]
initialA FlowSound
ts
  | Bool
otherwise = [Sound8
t]FlowSound -> [FlowSound] -> [FlowSound]
forall a. a -> [a] -> [a]
:FlowSound -> [FlowSound]
initialA FlowSound
ts
initialA FlowSound
_ = []

bsToCharUkr :: [FlowSound] -> FlowSound
bsToCharUkr :: [FlowSound] -> FlowSound
bsToCharUkr [FlowSound]
zs
 | [FlowSound] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FlowSound]
zs = []
 | Bool
otherwise = (FlowSound -> Sound8) -> [FlowSound] -> FlowSound
forall a b. (a -> b) -> [a] -> [b]
map FlowSound -> Sound8
forall p. (Num p, Ord p) => [p] -> p
g [FlowSound]
zs
     where g :: [p] -> p
g [p]
ts
             | [p] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [p]
ts = -p
1
             | Bool
otherwise = p -> [([p], p)] -> [p] -> p
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' ([p] -> p
forall a. [a] -> a
head [p]
ts) [([p
17,p
10],p
23),([p
17,p
25],p
8),([p
32,p
50],p
62),([p
38,p
7],p
66),([p
49,p
7],p
54),
                  ([p
49,p
50],p
63),([p
50,p
7],p
64),([p
50,p
49],p
38),([p
52,p
21],p
21)] [p]
ts

applyChanges :: FlowSound -> FlowSound
applyChanges :: FlowSound -> FlowSound
applyChanges [] = []
applyChanges FlowSound
ys = (Sound8 -> FlowSound -> FlowSound)
-> FlowSound -> FlowSound -> FlowSound
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Sound8 -> FlowSound -> FlowSound
f FlowSound
forall a. [a]
v FlowSound
ys
  where v :: [a]
v = []
        f :: Sound8 -> FlowSound -> FlowSound
f Sound8
x FlowSound
xs
          | FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
xs = [Sound8
x]
          | Bool
otherwise = Sound8 -> [(Sound8, Sound8)] -> Sound8 -> Sound8
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Sound8
x (FlowSound -> FlowSound -> [(Sound8, Sound8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Sound8
8,Sound8
10,Sound8
17,Sound8
21,Sound8
25,Sound8
38,Sound8
39,Sound8
41,Sound8
43,Sound8
45,Sound8
47,Sound8
49,Sound8
50,Sound8
52,Sound8
54,Sound8
62,Sound8
63,Sound8
64,Sound8
66] [FlowSound -> Sound8
дзT FlowSound
xs,
                 FlowSound -> Sound8
жT FlowSound
xs, FlowSound -> Sound8
дT FlowSound
xs, FlowSound -> Sound8
гT FlowSound
xs, FlowSound -> Sound8
зT FlowSound
xs, FlowSound -> Sound8
цT FlowSound
xs, FlowSound -> Sound8
чT FlowSound
xs, FlowSound -> Sound8
шT FlowSound
xs, FlowSound -> Sound8
фT FlowSound
xs, FlowSound -> Sound8
кT FlowSound
xs, FlowSound -> Sound8
пT FlowSound
xs, FlowSound -> Sound8
сT FlowSound
xs, FlowSound -> Sound8
тT FlowSound
xs, FlowSound -> Sound8
хT FlowSound
xs,
                   FlowSound -> Sound8
сьT FlowSound
xs, FlowSound -> Sound8
нтT FlowSound
xs, FlowSound -> Sound8
стT FlowSound
xs, FlowSound -> Sound8
тьT FlowSound
xs, FlowSound -> Sound8
цьT FlowSound
xs]) Sound8
xSound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:FlowSound
xs

isVoicedObstruent :: FlowSound -> Bool
isVoicedObstruent :: FlowSound -> Bool
isVoicedObstruent FlowSound
xs
 | FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
xs = Bool
False
 | Bool
otherwise = (\Sound8
u -> Sound8
u Sound8 -> Sound8 -> Bool
forall a. Ord a => a -> a -> Bool
> Sound8
7 Bool -> Bool -> Bool
&& Sound8
u Sound8 -> Sound8 -> Bool
forall a. Ord a => a -> a -> Bool
< Sound8
27) (Sound8 -> Bool) -> (FlowSound -> Sound8) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> Sound8
forall a. [a] -> a
head (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
xs

isVoicedObstruentH :: FlowSound -> Bool
isVoicedObstruentH :: FlowSound -> Bool
isVoicedObstruentH FlowSound
xs
 | FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
xs = Bool
False
 | Bool
otherwise = Bool -> [(Sound8, Bool)] -> Sound8 -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False [(Sound8
8,Bool
True),(Sound8
10,Bool
True),(Sound8
15,Bool
True),(Sound8
17,Bool
True),(Sound8
19,Bool
True),(Sound8
21,Bool
True),(Sound8
23,Bool
True),(Sound8
25, Bool
True)] (Sound8 -> Bool) -> (FlowSound -> Sound8) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> Sound8
forall a. [a] -> a
head (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
xs

isVoicedObstruentS :: FlowSound -> Bool
isVoicedObstruentS :: FlowSound -> Bool
isVoicedObstruentS FlowSound
xs
 | FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
xs = Bool
False
 | Bool
otherwise = (\Sound8
u -> Sound8
u Sound8 -> Sound8 -> Bool
forall a. Ord a => a -> a -> Bool
> Sound8
11 Bool -> Bool -> Bool
&& Sound8
u Sound8 -> Sound8 -> Bool
forall a. Ord a => a -> a -> Bool
< Sound8
15) (Sound8 -> Bool) -> (FlowSound -> Sound8) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> Sound8
forall a. [a] -> a
head (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
xs

isSoftDOrL :: FlowSound -> Bool
isSoftDOrL :: FlowSound -> Bool
isSoftDOrL FlowSound
xs = Bool -> [(FlowSound, Bool)] -> FlowSound -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([FlowSound] -> [Bool] -> [(FlowSound, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Sound8
15,Sound8
7],[Sound8
17,Sound8
7],[Sound8
28,Sound8
7],[Sound8
30,Sound8
7],[Sound8
32,Sound8
7],[Sound8
36,Sound8
7],[Sound8
38,Sound8
7],[Sound8
43,Sound8
7],[Sound8
47,Sound8
7],[Sound8
49,Sound8
7],[Sound8
50,Sound8
7]]
 (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)) (Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
xs) Bool -> Bool -> Bool
|| Bool -> [(FlowSound, Bool)] -> FlowSound -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([FlowSound] -> [Bool] -> [(FlowSound, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Sound8
12],[Sound8
13],[Sound8
14],[Sound8
64],[Sound8
65]] ([Bool] -> [(FlowSound, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(FlowSound, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(FlowSound, Bool)]) -> Bool -> [(FlowSound, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
   (Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
xs)

isSoftDen :: FlowSound -> Bool
isSoftDen :: FlowSound -> Bool
isSoftDen FlowSound
xs = Bool -> [(FlowSound, Bool)] -> FlowSound -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([FlowSound] -> [Bool] -> [(FlowSound, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Sound8
8,Sound8
7],[Sound8
17,Sound8
7],[Sound8
25,Sound8
7],[Sound8
28,Sound8
7],[Sound8
32,Sound8
7],[Sound8
38,Sound8
7],[Sound8
49,Sound8
7],[Sound8
50,Sound8
7]] ([Bool] -> [(FlowSound, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(FlowSound, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(FlowSound, Bool)]) -> Bool -> [(FlowSound, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
 (Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
xs) Bool -> Bool -> Bool
|| Bool -> [(FlowSound, Bool)] -> FlowSound -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([FlowSound] -> [Bool] -> [(FlowSound, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Sound8
12],[Sound8
13],[Sound8
14],[Sound8
64],[Sound8
65]] ([Bool] -> [(FlowSound, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(FlowSound, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(FlowSound, Bool)]) -> Bool -> [(FlowSound, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
   (Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
xs)

гT :: FlowSound -> Sound8
гT :: FlowSound -> Sound8
гT (Sound8
t:FlowSound
_) | Sound8
t Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
45 Bool -> Bool -> Bool
|| Sound8
t Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
50 = Sound8
52 -- г х
         | Bool
otherwise = Sound8
21
гT FlowSound
_ = Sound8
21

дT :: FlowSound -> Sound8
дT :: FlowSound -> Sound8
дT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
10],[Sound8
39],[Sound8
41]] = Sound8
23 --  д дж
            | Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
49,Sound8
7],[Sound8
38,Sound8
7]] = Sound8
12 --  д дзь
            | Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
54],[Sound8
66]] = Sound8
12 --  д дзь
            | Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
25],[Sound8
49],[Sound8
38]] = Sound8
8 --   д дз
            | Bool
otherwise = Sound8
17
дT FlowSound
_ = Sound8
17

дзT :: FlowSound -> Sound8
дзT :: FlowSound -> Sound8
дзT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | FlowSound -> Bool
isSoftDOrL FlowSound
t1 = Sound8
12 -- дз дзь
             | Bool
otherwise = Sound8
8
дзT FlowSound
_ = Sound8
8

жT :: FlowSound -> Sound8
жT :: FlowSound -> Sound8
жT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | Int -> FlowSound -> FlowSound
takeFromFT Int
2 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
49,Sound8
7],[Sound8
38,Sound8
7]] = Sound8
13  -- ж зь
            | Int -> FlowSound -> FlowSound
takeFromFT Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
54],[Sound8
66]] = Sound8
13
            | Bool
otherwise = Sound8
10
жT FlowSound
_ = Sound8
10

зT :: FlowSound -> Sound8
зT :: FlowSound -> Sound8
зT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
10],[Sound8
39],[Sound8
41]] Bool -> Bool -> Bool
|| Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
17,Sound8
10] Bool -> Bool -> Bool
|| Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
23] = Sound8
10  -- з ж
            | FlowSound -> Bool
isSoftDOrL FlowSound
t1 = Sound8
13        -- з зь
            | Int -> FlowSound -> FlowSound
takeFromFT Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
39],[Sound8
41]] = Sound8
41 --  з ш
            | Int -> FlowSound -> FlowSound
takeFromFT Int
1 FlowSound
t1  FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
49],[Sound8
38]] Bool -> Bool -> Bool
|| Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
45],[Sound8
47],[Sound8
50],[Sound8
43],[Sound8
52]] = Sound8
49 --  з с
            | Bool
otherwise = Sound8
25
зT FlowSound
_ = Sound8
25

кT :: FlowSound -> Sound8
кT :: FlowSound -> Sound8
кT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
19
            | Bool
otherwise = Sound8
45
кT FlowSound
_ = Sound8
45

нтT :: FlowSound -> Sound8
нтT :: FlowSound -> Sound8
нтT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | Int -> FlowSound -> FlowSound
takeFromFT Int
2 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
49,Sound8
50] Bool -> Bool -> Bool
|| Int -> FlowSound -> FlowSound
takeFromFT Int
1 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
63] = Sound8
32
             | Int -> FlowSound -> FlowSound
takeFromFT Int
3 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
49,Sound8
7,Sound8
45] Bool -> Bool -> Bool
|| Int -> FlowSound -> FlowSound
takeFromFT Int
2 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
54,Sound8
45] = Sound8
65
             | Bool
otherwise = Sound8
62
нтT FlowSound
_ = Sound8
62

пT :: FlowSound -> Sound8
пT :: FlowSound -> Sound8
пT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
15
            | Bool
otherwise = Sound8
47
пT FlowSound
_ = Sound8
47

сT :: FlowSound -> Sound8
сT :: FlowSound -> Sound8
сT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | ((FlowSound -> Bool
isVoicedObstruentH (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1) Bool -> Bool -> Bool
&& Int -> FlowSound -> FlowSound
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1) FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
7]) Bool -> Bool -> Bool
||
                FlowSound -> Bool
isVoicedObstruentS (Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1) = Sound8
13
            | FlowSound -> Bool
isVoicedObstruentH (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
25
            | FlowSound -> Bool
isSoftDOrL FlowSound
t1 = Sound8
54
            | Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
41] = Sound8
41
            | Bool
otherwise = Sound8
49
сT FlowSound
_ = Sound8
49

стT :: FlowSound -> Sound8
стT :: FlowSound -> Sound8
стT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1  = Sound8
25
             | Int -> FlowSound -> FlowSound
takeFromFT_ Int
3 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
49,Sound8
7,Sound8
45] Bool -> Bool -> Bool
|| (Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
54,Sound8
45],[Sound8
38,Sound8
7]]) Bool -> Bool -> Bool
||
                      Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
66] = Sound8
54
             | Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
49],[Sound8
32]] = Sound8
49
             | Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
39] = Sound8
41
             | Bool
otherwise = Sound8
63
стT FlowSound
_ = Sound8
63

сьT :: FlowSound -> Sound8
сьT :: FlowSound -> Sound8
сьT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
13
             | Bool
otherwise = Sound8
54
сьT FlowSound
_ = Sound8
54

тT :: FlowSound -> Sound8
тT :: FlowSound -> Sound8
тT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | ((FlowSound -> Bool
isVoicedObstruentH (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1) Bool -> Bool -> Bool
&& Int -> FlowSound -> FlowSound
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1) FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
7]) Bool -> Bool -> Bool
||
                  FlowSound -> Bool
isVoicedObstruentS (Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1) = Sound8
14
            | FlowSound -> Bool
isVoicedObstruentH (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
17
            | Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
38,Sound8
7] Bool -> Bool -> Bool
|| Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
66]  = Sound8
66
            | Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
38] = Sound8
38
            | FlowSound -> Bool
isSoftDen FlowSound
t1 = Sound8
64
            | Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
39],[Sound8
41]] = Sound8
39
            | Bool
otherwise = Sound8
50
тT FlowSound
_ = Sound8
50

тьT :: FlowSound -> Sound8
тьT :: FlowSound -> Sound8
тьT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
14
             | Int -> FlowSound -> FlowSound
takeFromFT_ Int
3 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
49,Sound8
7,Sound8
1] Bool -> Bool -> Bool
|| Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1 FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
54,Sound8
1] = Sound8
66
             | Bool
otherwise = Sound8
64
тьT FlowSound
_ = Sound8
64

фT :: FlowSound -> Sound8
фT :: FlowSound -> Sound8
фT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
36
            | Bool
otherwise = Sound8
43
фT FlowSound
_ = Sound8
43

хT :: FlowSound -> Sound8
хT :: FlowSound -> Sound8
хT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
21
            | Bool
otherwise = Sound8
52
хT FlowSound
_ = Sound8
52

цT :: FlowSound -> Sound8
цT :: FlowSound -> Sound8
цT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | ((FlowSound -> Bool
isVoicedObstruentH (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1) Bool -> Bool -> Bool
&& Int -> FlowSound -> FlowSound
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1) FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
7]) Bool -> Bool -> Bool
||
                FlowSound -> Bool
isVoicedObstruentS (Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1) = Sound8
12
            | FlowSound -> Bool
isSoftDOrL FlowSound
t1 = Sound8
66
            | FlowSound -> Bool
isVoicedObstruentH (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
8
            | Bool
otherwise = Sound8
38
цT FlowSound
_ = Sound8
38

цьT :: FlowSound -> Sound8
цьT :: FlowSound -> Sound8
цьT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | (FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1) Bool -> Bool -> Bool
&& Int -> FlowSound -> FlowSound
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1) FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
7] = Sound8
12
             | Bool
otherwise = Sound8
66
цьT FlowSound
_ = Sound8
66

чT :: FlowSound -> Sound8
чT :: FlowSound -> Sound8
чT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
49,Sound8
7],[Sound8
38,Sound8
7]] Bool -> Bool -> Bool
|| Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
54],[Sound8
66]] = Sound8
66
            | FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
23
            | Bool
otherwise = Sound8
39
чT FlowSound
_ = Sound8
39

шT :: FlowSound -> Sound8
шT :: FlowSound -> Sound8
шT t1 :: FlowSound
t1@(Sound8
_:FlowSound
_) | Int -> FlowSound -> FlowSound
takeFromFT_ Int
2 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
49,Sound8
7],[Sound8
38,Sound8
7]] Bool -> Bool -> Bool
|| Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 FlowSound
t1 FlowSound -> [FlowSound] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Sound8
54],[Sound8
66]] = Sound8
54
            | FlowSound -> Bool
isVoicedObstruent (FlowSound -> Bool)
-> (FlowSound -> FlowSound) -> FlowSound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> FlowSound -> FlowSound
takeFromFT_ Int
1 (FlowSound -> Bool) -> FlowSound -> Bool
forall a b. (a -> b) -> a -> b
$ FlowSound
t1 = Sound8
10
            | Bool
otherwise = Sound8
41
шT FlowSound
_ = Sound8
41

takeFromFT :: Int -> FlowSound -> FlowSound
takeFromFT :: Int -> FlowSound -> FlowSound
takeFromFT Int
n FlowSound
ts | if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then Bool
True else FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
ts = []
                | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = [Sound8
k]
                | Bool
otherwise = Sound8
k Sound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
: Int -> FlowSound -> FlowSound
takeFromFT (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> FlowSound -> FlowSound
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) FlowSound
ts)
    where k :: Sound8
k = FlowSound -> Sound8
forall a. [a] -> a
head FlowSound
ts

takeFromFT2 :: Int -> FlowSound -> FlowSound
takeFromFT2 :: Int -> FlowSound -> FlowSound
takeFromFT2 Int
n FlowSound
ts | if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then Bool
True else FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
ts = []
                 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = [Sound8
ks]
                 | Bool
otherwise = Sound8
ksSound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:Int -> FlowSound -> FlowSound
takeFromFT2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (FlowSound -> FlowSound
forall a. [a] -> [a]
tail FlowSound
ts)
    where ks :: Sound8
ks = FlowSound -> Sound8
forall a. [a] -> a
head FlowSound
ts

dropFromFT2 :: Int -> FlowSound -> FlowSound
dropFromFT2 :: Int -> FlowSound -> FlowSound
dropFromFT2 Int
n FlowSound
ts | if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then Bool
True else FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
ts = []
                 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = FlowSound -> FlowSound
forall a. [a] -> [a]
tail FlowSound
ts
                 | Bool
otherwise = Int -> FlowSound -> FlowSound
dropFromFT2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (FlowSound -> FlowSound
forall a. [a] -> [a]
tail FlowSound
ts)

takeFromFT_ :: Int -> FlowSound -> FlowSound
takeFromFT_ :: Int -> FlowSound -> FlowSound
takeFromFT_ Int
n = Int -> FlowSound -> FlowSound
takeFromFT Int
n (FlowSound -> FlowSound)
-> (FlowSound -> FlowSound) -> FlowSound -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sound8 -> Bool) -> FlowSound -> FlowSound
forall a. (a -> Bool) -> [a] -> [a]
filter (Sound8 -> Sound8 -> Bool
forall a. Ord a => a -> a -> Bool
>Sound8
0)

correctA :: FlowSound -> FlowSound
correctA :: FlowSound -> FlowSound
correctA = FlowSound -> FlowSound
correctSomeW (FlowSound -> FlowSound)
-> (FlowSound -> FlowSound) -> FlowSound -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> FlowSound
separateSoftS

separateSoftS :: FlowSound -> FlowSound
separateSoftS :: FlowSound -> FlowSound
separateSoftS = (Sound8 -> FlowSound) -> FlowSound -> FlowSound
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Sound8 -> FlowSound
divideToParts

correctSomeW :: FlowSound -> FlowSound
correctSomeW :: FlowSound -> FlowSound
correctSomeW (Sound8
x:Sound8
y:Sound8
z:xs :: FlowSound
xs@(Sound8
t:FlowSound
ys))
 | Sound8
x Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
50 Bool -> Bool -> Bool
&& Sound8
y Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
7 Bool -> Bool -> Bool
&& Sound8
z Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
54 Bool -> Bool -> Bool
&& Sound8
t Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
1 = Sound8
66Sound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:Sound8
66Sound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:Sound8
1Sound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:FlowSound -> FlowSound
correctSomeW FlowSound
ys
 | (Sound8
x Sound8 -> Sound8 -> Bool
forall a. Ord a => a -> a -> Bool
< Sound8
1) Bool -> Bool -> Bool
&& Sound8
y Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
27 Bool -> Bool -> Bool
&& Sound8
z Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
1 =
  if Int -> FlowSound -> FlowSound
forall a. Int -> [a] -> [a]
take Int
2 FlowSound
xs FlowSound -> FlowSound -> Bool
forall a. Eq a => a -> a -> Bool
== [Sound8
39,Sound8
32]
    then Sound8
xSound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:Sound8
ySound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:Sound8
zSound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:Sound8
41Sound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:FlowSound -> FlowSound
correctSomeW FlowSound
ys
    else Sound8
xSound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:FlowSound -> FlowSound
correctSomeW (Sound8
ySound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:Sound8
zSound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:FlowSound
xs)
                        | Bool
otherwise = Sound8
xSound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:FlowSound -> FlowSound
correctSomeW (Sound8
ySound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:Sound8
zSound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:FlowSound
xs)
correctSomeW FlowSound
zs = FlowSound
zs

divideToParts :: Sound8 -> FlowSound
divideToParts :: Sound8 -> FlowSound
divideToParts Sound8
x =
  FlowSound -> [(Sound8, FlowSound)] -> Sound8 -> FlowSound
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' [Sound8
x] [(Sound8
12,[Sound8
8,Sound8
7]),(Sound8
13,[Sound8
25,Sound8
7]),(Sound8
14,[Sound8
17,Sound8
7]),(Sound8
62,[Sound8
32,Sound8
50]),(Sound8
63,[Sound8
49,Sound8
50]),(Sound8
64,[Sound8
50,Sound8
7]), (Sound8
65,[Sound8
32,Sound8
7])] Sound8
x

correctB :: FlowSound -> FlowSound
correctB :: FlowSound -> FlowSound
correctB ys :: FlowSound
ys@(Sound8
x:FlowSound
xs)
  | (FlowSound -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FlowSound -> Int) -> (FlowSound -> FlowSound) -> FlowSound -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sound8 -> Bool) -> FlowSound -> FlowSound
forall a. (a -> Bool) -> [a] -> [a]
filter (Sound8 -> Sound8 -> Bool
forall a. Eq a => a -> a -> Bool
== Sound8
0) (FlowSound -> FlowSound)
-> (FlowSound -> FlowSound) -> FlowSound -> FlowSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FlowSound -> FlowSound
takeFromFT2 Int
6 (FlowSound -> Int) -> FlowSound -> Int
forall a b. (a -> b) -> a -> b
$ FlowSound
ys) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = (Sound8 -> Sound8) -> FlowSound -> FlowSound
forall a b. (a -> b) -> [a] -> [b]
map (\Sound8
t -> if Sound8
t Sound8 -> Sound8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Sound8
0 then -Sound8
1 else Sound8
t) (Int -> FlowSound -> FlowSound
takeFromFT2 Int
6 FlowSound
ys) FlowSound -> FlowSound -> FlowSound
forall a. [a] -> [a] -> [a]
++ FlowSound -> FlowSound
correctB (Int -> FlowSound -> FlowSound
dropFromFT2 Int
6 FlowSound
ys)
  | Bool
otherwise = (if Sound8
x Sound8 -> Sound8 -> Bool
forall a. Ord a => a -> a -> Bool
< Sound8
0 then -Sound8
1 else Sound8
x)Sound8 -> FlowSound -> FlowSound
forall a. a -> [a] -> [a]
:FlowSound -> FlowSound
correctB FlowSound
xs
correctB FlowSound
_ = []

-- | Can be used to map the 'Sound8' representation and the mmsyn6ukr-array files with some recordings.
linkFileNameI8 :: Sound8 -> Char
linkFileNameI8 :: Sound8 -> Char
linkFileNameI8 Sound8
x = Char -> [(Sound8, Char)] -> Sound8 -> Char
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Char
'0' ([(Sound8
1,Char
'A'),(Sound8
2,Char
'H'),(Sound8
3,Char
'Q'),(Sound8
4,Char
'W'),(Sound8
5,Char
'K'),(Sound8
6,Char
'e'),(Sound8
7,Char
'd'),(Sound8
8,Char
'G'),(Sound8
10,Char
'I'),(Sound8
15,Char
'B'),
  (Sound8
17,Char
'E'),(Sound8
19,Char
'f'),(Sound8
21,Char
'D'),(Sound8
23,Char
'F'),(Sound8
25,Char
'J'),(Sound8
27,Char
'L'),(Sound8
28,Char
'N'),(Sound8
30,Char
'O'),(Sound8
32,Char
'P'),(Sound8
34,Char
'S'),(Sound8
36,Char
'C'),(Sound8
38,Char
'Z'),(Sound8
39,Char
'b'),
    (Sound8
41,Char
'c'),(Sound8
43,Char
'X'),(Sound8
45,Char
'M'),(Sound8
47,Char
'R'),(Sound8
49,Char
'T'),(Sound8
50,Char
'V'),(Sound8
52,Char
'Y'),(Sound8
54,Char
'U'),(Sound8
60,Char
'0'),(Sound8
61,Char
'0'),(Sound8
66,Char
'a')]) Sound8
x