{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Melodics.ByteString.Ukrainian.Arr
-- 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

module Melodics.ByteString.Ukrainian.Arr (
  -- * Basic functions
  convertToProperUkrainianS
  , convertToProperUkrainianB
  , isUkrainianL
  , linkFileName
  , showInteresting
) where

import qualified Data.String as S
import Data.Maybe (fromJust)
import Data.Char
import GHC.Arr
import CaseBi.Arr
import qualified Data.ByteString.Char8 as B

{-
-- Inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html
-}

data Triple = Z | O | T
  deriving (Triple -> Triple -> Bool
(Triple -> Triple -> Bool)
-> (Triple -> Triple -> Bool) -> Eq Triple
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Triple -> Triple -> Bool
$c/= :: Triple -> Triple -> Bool
== :: Triple -> Triple -> Bool
$c== :: Triple -> Triple -> Bool
Eq,Eq Triple
Eq Triple
-> (Triple -> Triple -> Ordering)
-> (Triple -> Triple -> Bool)
-> (Triple -> Triple -> Bool)
-> (Triple -> Triple -> Bool)
-> (Triple -> Triple -> Bool)
-> (Triple -> Triple -> Triple)
-> (Triple -> Triple -> Triple)
-> Ord Triple
Triple -> Triple -> Bool
Triple -> Triple -> Ordering
Triple -> Triple -> Triple
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Triple -> Triple -> Triple
$cmin :: Triple -> Triple -> Triple
max :: Triple -> Triple -> Triple
$cmax :: Triple -> Triple -> Triple
>= :: Triple -> Triple -> Bool
$c>= :: Triple -> Triple -> Bool
> :: Triple -> Triple -> Bool
$c> :: Triple -> Triple -> Bool
<= :: Triple -> Triple -> Bool
$c<= :: Triple -> Triple -> Bool
< :: Triple -> Triple -> Bool
$c< :: Triple -> Triple -> Bool
compare :: Triple -> Triple -> Ordering
$ccompare :: Triple -> Triple -> Ordering
$cp1Ord :: Eq Triple
Ord,Int -> Triple -> ShowS
[Triple] -> ShowS
Triple -> String
(Int -> Triple -> ShowS)
-> (Triple -> String) -> ([Triple] -> ShowS) -> Show Triple
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Triple] -> ShowS
$cshowList :: [Triple] -> ShowS
show :: Triple -> String
$cshow :: Triple -> String
showsPrec :: Int -> Triple -> ShowS
$cshowsPrec :: Int -> Triple -> ShowS
Show)

convertToProperUkrainianS :: String -> String
convertToProperUkrainianS :: ShowS
convertToProperUkrainianS = ShowS
correctB ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Triple)] -> String
correctA ([(Char, Triple)] -> String)
-> (String -> [(Char, Triple)]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Triple)] -> [(Char, Triple)]
applyChanges ([(Char, Triple)] -> [(Char, Triple)])
-> (String -> [(Char, Triple)]) -> String -> [(Char, Triple)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, Triple)] -> [(Char, Triple)]
bsToCharUkr ([(ByteString, Triple)] -> [(Char, Triple)])
-> (String -> [(ByteString, Triple)]) -> String -> [(Char, Triple)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, Triple)]
createTuplesByAnalysis (ByteString -> [(ByteString, Triple)])
-> (String -> ByteString) -> String -> [(ByteString, Triple)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
secondConv (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
filterUkr (String -> ByteString) -> ShowS -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
changeIotated ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (Char -> Bool) -> ShowS
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) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

isUkrainianL :: Char -> Bool
isUkrainianL :: Char -> Bool
isUkrainianL Char
y | (Char
y Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\1070' Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\1097') = Bool
True
               | Bool
otherwise = Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ((Char -> (Char, Bool)) -> String -> [(Char, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> (Char
x, Bool
True)) String
"'-\700\1028\1030\1031\1068\1100\1102\1103\1108\1110\1111\1168\1169\8217") Char
y

changeIotated :: String -> String
changeIotated :: ShowS
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 -> ShowS
forall a. a -> [a] -> [a]
:Char
'\1100'Char -> ShowS
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 -> ShowS
forall a. a -> [a] -> [a]
:ShowS
changeIotated String
zs
  | Bool
otherwise = Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
changeIotated (Char
yChar -> ShowS
forall a. a -> [a] -> [a]
:String
zs)
changeIotated String
xs = String
xs

isConsNotJ :: Char -> Bool
isConsNotJ :: Char -> Bool
isConsNotJ = Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False (String -> [Bool] -> [(Char, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"\1073\1074\1075\1076\1078\1079\1082\1083\1084\1085\1087\1088\1089\1090\1092\1093\1094\1095\1096\1097\1169" (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True))

filterUkr :: String -> B.ByteString
filterUkr :: String -> ByteString
filterUkr = String -> ByteString
B.pack (String -> ByteString) -> ShowS -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toBSUkr

toBSUkr :: Char -> Char
toBSUkr :: Char -> Char
toBSUkr Char
x = Char -> [(Char, Char)] -> Char -> Char
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Char
x (String -> String -> [(Char, Char)]
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" String
"LabvhdeBzyCklmnoprstufxcEFGqHIJiKgM") Char
x

secondConv :: B.ByteString -> B.ByteString
secondConv :: ByteString -> ByteString
secondConv = (Char -> ByteString) -> ByteString -> ByteString
B.concatMap Char -> ByteString
f
  where f :: Char -> ByteString
f Char
y
         | Char -> Bool
isSpace Char
y Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
y = Char -> ByteString
B.singleton Char
'1'
         | Bool
otherwise = ByteString -> [(Char, ByteString)] -> Char -> ByteString
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' (Char -> ByteString
B.singleton Char
y) (String -> [ByteString] -> [(Char, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"'-GHIJKLM" [Char -> ByteString
B.singleton Char
'0',Char -> ByteString
B.singleton Char
'0',ByteString
"FE",ByteString
"Cu",ByteString
"Ca",ByteString
"Ce",ByteString
"Ci",Char -> ByteString
B.singleton Char
'0',Char -> ByteString
B.singleton Char
'0']) Char
y

createTuplesByAnalysis :: B.ByteString -> [(B.ByteString, Triple)]
createTuplesByAnalysis :: ByteString -> [(ByteString, Triple)]
createTuplesByAnalysis ByteString
x
  | ByteString -> Bool
B.null ByteString
x = []
  | Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False (String -> [Bool] -> [(Char, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"BEFcdfhknpstxz" (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)) (Char -> Bool) -> (ByteString -> Char) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char
B.head (ByteString -> Bool) -> ByteString -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString
x = ByteString -> [(ByteString, Triple)]
initialA ByteString
x
  | Bool -> Bool
not (ByteString -> Bool
B.null (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.tail (ByteString -> Bool) -> ByteString -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString
x) Bool -> Bool -> Bool
&& (ByteString -> Int -> Char
B.index ByteString
x Int
1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'C' Bool -> Bool -> Bool
&& Char -> Bool
isConsNotJ (ByteString -> Char
B.head ByteString
x)) = (ByteString -> ByteString
B.copy (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
B.singleton (Char -> ByteString)
-> (ByteString -> Char) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char
B.head (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
x, Triple
T)(ByteString, Triple)
-> [(ByteString, Triple)] -> [(ByteString, Triple)]
forall a. a -> [a] -> [a]
:(Char -> ByteString
B.singleton Char
'q', Triple
Z)(ByteString, Triple)
-> [(ByteString, Triple)] -> [(ByteString, Triple)]
forall a. a -> [a] -> [a]
:ByteString -> [(ByteString, Triple)]
createTuplesByAnalysis (Int -> ByteString -> ByteString
B.drop Int
2 ByteString
x)
  | Bool
otherwise = (ByteString -> ByteString
B.copy (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
B.singleton (Char -> ByteString)
-> (ByteString -> Char) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char
B.head (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
x, Triple
Z)(ByteString, Triple)
-> [(ByteString, Triple)] -> [(ByteString, Triple)]
forall a. a -> [a] -> [a]
:ByteString -> [(ByteString, Triple)]
createTuplesByAnalysis (ByteString -> ByteString
B.tail ByteString
x)


initialA :: B.ByteString -> [(B.ByteString, Triple)]
initialA :: ByteString -> [(ByteString, Triple)]
initialA ByteString
t1
  | ByteString -> Bool
B.null ByteString
t1 = []
  | Char -> Triple
canChange Char
t Triple -> Triple -> Bool
forall a. Eq a => a -> a -> Bool
== Triple
O = (Char -> ByteString
B.singleton Char
'1', Triple
Z)(ByteString, Triple)
-> [(ByteString, Triple)] -> [(ByteString, Triple)]
forall a. a -> [a] -> [a]
:ByteString -> [(ByteString, Triple)]
initialA ByteString
ts
  | Char -> Triple
canChange Char
t Triple -> Triple -> Bool
forall a. Eq a => a -> a -> Bool
== Triple
Z = (Char -> ByteString
B.singleton Char
t, Triple
Z)(ByteString, Triple)
-> [(ByteString, Triple)] -> [(ByteString, Triple)]
forall a. a -> [a] -> [a]
:ByteString -> [(ByteString, Triple)]
initialA ByteString
ts
  | Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False (String -> [Bool] -> [(Char, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"cdnstx" (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)) Char
t =
     let (ByteString
us,ByteString
vs) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
2 ByteString
t1 in
       if Bool -> [(ByteString, Bool)] -> ByteString -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([ByteString] -> [Bool] -> [(ByteString, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString
"cq",ByteString
"dB",ByteString
"dz",ByteString
"nt",ByteString
"sq",ByteString
"st",ByteString
"tq",ByteString
"ts",ByteString
"xh"] (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)) ByteString
us
        then (ByteString -> ByteString
B.copy ByteString
us, Triple
T)(ByteString, Triple)
-> [(ByteString, Triple)] -> [(ByteString, Triple)]
forall a. a -> [a] -> [a]
:ByteString -> [(ByteString, Triple)]
initialA ByteString
vs
        else (Char -> ByteString
B.singleton Char
t, Triple
T)(ByteString, Triple)
-> [(ByteString, Triple)] -> [(ByteString, Triple)]
forall a. a -> [a] -> [a]
:ByteString -> [(ByteString, Triple)]
initialA ByteString
ts
  | Bool
otherwise = (Char -> ByteString
B.singleton Char
t, Triple
T)(ByteString, Triple)
-> [(ByteString, Triple)] -> [(ByteString, Triple)]
forall a. a -> [a] -> [a]
:ByteString -> [(ByteString, Triple)]
initialA ByteString
ts
      where (Char
t,ByteString
ts) = Maybe (Char, ByteString) -> (Char, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Char, ByteString) -> (Char, ByteString))
-> (ByteString -> Maybe (Char, ByteString))
-> ByteString
-> (Char, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Char, ByteString)
B.uncons (ByteString -> (Char, ByteString))
-> ByteString -> (Char, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
t1

canChange :: Char -> Triple
canChange :: Char -> Triple
canChange Char
x
  | Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = Triple
O
  | Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False (String -> [Bool] -> [(Char, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"BEFcdfhknpstxz" (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)) Char
x = Triple
T
  | Bool
otherwise = Triple
Z

bsToCharUkr :: [(B.ByteString,Triple)] -> [(Char,Triple)]
bsToCharUkr :: [(ByteString, Triple)] -> [(Char, Triple)]
bsToCharUkr [(ByteString, Triple)]
zs
 | [(ByteString, Triple)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ByteString, Triple)]
zs = []
 | Bool
otherwise = ((ByteString, Triple) -> (Char, Triple))
-> [(ByteString, Triple)] -> [(Char, Triple)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Triple) -> (Char, Triple)
g [(ByteString, Triple)]
zs
     where g :: (ByteString, Triple) -> (Char, Triple)
g (ByteString
ts,Triple
k)
             | ByteString -> Bool
B.null ByteString
ts = (Char
'0',Triple
Z)
             | Bool
otherwise = (Char -> [(ByteString, Char)] -> ByteString -> Char
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' (ByteString -> Char
B.head ByteString
ts) ([ByteString] -> String -> [(ByteString, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString
"cq",ByteString
"dB",ByteString
"dz",ByteString
"nt",ByteString
"sq",ByteString
"st",ByteString
"tq",ByteString
"ts",ByteString
"xh"]  String
"wjANDOPch") ByteString
ts,Triple
k)

applyChanges :: [(Char, Triple)] -> [(Char, Triple)]
applyChanges :: [(Char, Triple)] -> [(Char, Triple)]
applyChanges [] = []
applyChanges [(Char, Triple)]
ys = ((Char, Triple) -> [(Char, Triple)] -> [(Char, Triple)])
-> [(Char, Triple)] -> [(Char, Triple)] -> [(Char, Triple)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Char, Triple) -> [(Char, Triple)] -> [(Char, Triple)]
f [(Char, Triple)]
forall a. [a]
v [(Char, Triple)]
ys
  where v :: [a]
v = []
        f :: (Char, Triple) -> [(Char, Triple)] -> [(Char, Triple)]
f (Char, Triple)
x [(Char, Triple)]
xs
          | [(Char, Triple)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Char, Triple)]
xs = ((Char, Triple) -> [(Char, Triple)] -> [(Char, Triple)]
forall a. a -> [a] -> [a]
:[]) ((Char, Triple) -> [(Char, Triple)])
-> ((Char, Triple) -> (Char, Triple))
-> (Char, Triple)
-> [(Char, Triple)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Char
y,Triple
_) -> (Char
y, Triple
Z)) ((Char, Triple) -> [(Char, Triple)])
-> (Char, Triple) -> [(Char, Triple)]
forall a b. (a -> b) -> a -> b
$ (Char, Triple)
x
          | (Char, Triple) -> Triple
forall a b. (a, b) -> b
snd (Char, Triple)
x Triple -> Triple -> Bool
forall a. Eq a => a -> a -> Bool
== Triple
T =
               (Char, Triple)
-> [(Char, (Char, Triple))] -> Char -> (Char, Triple)
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' ((Char, Triple) -> Char
forall a b. (a, b) -> a
fst (Char, Triple)
x, Triple
Z) (String -> [(Char, Triple)] -> [(Char, (Char, Triple))]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"ABDEFNOPcdfhkpstwxz" [[(Char, Triple)] -> (Char, Triple)
дзT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
жT [(Char, Triple)]
xs,  [(Char, Triple)] -> (Char, Triple)
сьT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
чT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
шT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
нтT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
стT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
тьT [(Char, Triple)]
xs,
                 [(Char, Triple)] -> (Char, Triple)
цT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
дT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
фT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
гT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
кT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
пT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
сT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
тT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
цьT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
хT [(Char, Triple)]
xs, [(Char, Triple)] -> (Char, Triple)
зT [(Char, Triple)]
xs]) ((Char, Triple) -> Char
forall a b. (a, b) -> a
fst (Char, Triple)
x)(Char, Triple) -> [(Char, Triple)] -> [(Char, Triple)]
forall a. a -> [a] -> [a]
:[(Char, Triple)]
xs
          | Bool
otherwise = (Char, Triple)
x(Char, Triple) -> [(Char, Triple)] -> [(Char, Triple)]
forall a. a -> [a] -> [a]
:[(Char, Triple)]
xs

isVoicedObstruent :: B.ByteString -> Bool
isVoicedObstruent :: ByteString -> Bool
isVoicedObstruent = Bool -> [(ByteString, Bool)] -> ByteString -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False [(ByteString
"A",Bool
True),(ByteString
"B",Bool
True),(ByteString
"Q",Bool
True),(ByteString
"R",Bool
True),(ByteString
"T",Bool
True),(ByteString
"b",Bool
True),(ByteString
"d",Bool
True),(ByteString
"g",Bool
True),(ByteString
"h",Bool
True),
  (ByteString
"j",Bool
True),(ByteString
"z", Bool
True)] (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
1

isVoicedObstruentH :: B.ByteString -> Bool
isVoicedObstruentH :: ByteString -> Bool
isVoicedObstruentH = Bool -> [(ByteString, Bool)] -> ByteString -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False [(ByteString
"A",Bool
True),(ByteString
"B",Bool
True),(ByteString
"b",Bool
True),(ByteString
"d",Bool
True),(ByteString
"g",Bool
True),(ByteString
"h",Bool
True),(ByteString
"j",Bool
True),(ByteString
"z", Bool
True)] (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
1

isVoicedObstruentS :: B.ByteString -> Bool
isVoicedObstruentS :: ByteString -> Bool
isVoicedObstruentS = (\ByteString
u -> (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
u) [ByteString
"Q",ByteString
"R",ByteString
"T"]) (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
1

isSoftDOrL :: [(Char, Triple)] -> Bool
isSoftDOrL :: [(Char, Triple)] -> Bool
isSoftDOrL [(Char, Triple)]
xs = Bool -> [(ByteString, Bool)] -> ByteString -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([ByteString] -> [Bool] -> [(ByteString, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString
"bq",ByteString
"cq",ByteString
"dq",ByteString
"fq",ByteString
"lq",ByteString
"mq",ByteString
"nq",ByteString
"pq",ByteString
"sq",ByteString
"tq",ByteString
"vq"] (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)) (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
xs) Bool -> Bool -> Bool
||
  Bool -> [(ByteString, Bool)] -> ByteString -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([ByteString] -> [Bool] -> [(ByteString, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString
"P",ByteString
"Q",ByteString
"R",ByteString
"S",ByteString
"T"] ([Bool] -> [(ByteString, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(ByteString, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(ByteString, Bool)]) -> Bool -> [(ByteString, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
xs)

isSoftDen :: [(Char, Triple)] -> Bool
isSoftDen :: [(Char, Triple)] -> Bool
isSoftDen [(Char, Triple)]
xs = Bool -> [(ByteString, Bool)] -> ByteString -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([ByteString] -> [Bool] -> [(ByteString, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString
"Aq",ByteString
"cq",ByteString
"dq",ByteString
"lq",ByteString
"nq",ByteString
"sq",ByteString
"tq",ByteString
"zq"] ([Bool] -> [(ByteString, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(ByteString, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(ByteString, Bool)]) -> Bool -> [(ByteString, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
xs) Bool -> Bool -> Bool
||
  Bool -> [(ByteString, Bool)] -> ByteString -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([ByteString] -> [Bool] -> [(ByteString, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString
"P",ByteString
"Q",ByteString
"R",ByteString
"S",ByteString
"T"] ([Bool] -> [(ByteString, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(ByteString, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(ByteString, Bool)]) -> Bool -> [(ByteString, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
xs)

-- 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 :: [(Char, Triple)] -> (Char, Triple)
гT ((Char, Triple)
t:[(Char, Triple)]
_) | (Char, Triple) -> Char
forall a b. (a, b) -> a
fst (Char, Triple)
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'k' Bool -> Bool -> Bool
|| (Char, Triple) -> Char
forall a b. (a, b) -> a
fst (Char, Triple)
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
't' = (Char
'x', Triple
Z)
         | Bool
otherwise = (Char
'h', Triple
Z)
гT [(Char, Triple)]
_ = (Char
'h', Triple
Z)

дT :: [(Char, Triple)] -> (Char, Triple)
дT :: [(Char, Triple)] -> (Char, Triple)
дT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"B",ByteString
"E",ByteString
"F"] = (Char
'j', Triple
Z) -- need further processing д дж
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"sq",ByteString
"cq"] = (Char
'Q', Triple
T) -- need further processing д дзь
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"D",ByteString
"w"] = (Char
'Q', Triple
T) -- need further processing д дзь
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"z",ByteString
"s",ByteString
"c"] = (Char
'A', Triple
Z) -- need further processing  д дз
            | Bool
otherwise = (Char
'd', Triple
Z)
дT [(Char, Triple)]
_ = (Char
'd', Triple
Z)

дзT :: [(Char, Triple)] -> (Char, Triple)
дзT :: [(Char, Triple)] -> (Char, Triple)
дзT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | [(Char, Triple)] -> Bool
isSoftDOrL [(Char, Triple)]
t1 = (Char
'Q', Triple
T)
             | Bool
otherwise = (Char
'A', Triple
Z)
дзT [(Char, Triple)]
_ = (Char
'A', Triple
Z)

жT :: [(Char, Triple)] -> (Char, Triple)
жT :: [(Char, Triple)] -> (Char, Triple)
жT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
2 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"sq",ByteString
"cq"] = (Char
'R', Triple
T)
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"D",ByteString
"w"] = (Char
'R', Triple
T)
            | Bool
otherwise = (Char
'B', Triple
Z)
жT [(Char, Triple)]
_ = (Char
'B', Triple
Z)

зT :: [(Char, Triple)] -> (Char, Triple)
зT :: [(Char, Triple)] -> (Char, Triple)
зT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"B",ByteString
"E",ByteString
"F"] Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"dB" Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"j" = (Char
'B', Triple
Z)
            | [(Char, Triple)] -> Bool
isSoftDOrL [(Char, Triple)]
t1 = (Char
'R', Triple
T)
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"E",ByteString
"F"] = (Char
'F', Triple
Z) -- need further processing з ш
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
1 [(Char, Triple)]
t1  ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"s",ByteString
"c"] Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"k",ByteString
"p",ByteString
"t",ByteString
"f",ByteString
"x"] = (Char
's', Triple
Z) -- need further processing з с
            | Bool
otherwise = (Char
'z', Triple
Z)
зT [(Char, Triple)]
_ = (Char
'z', Triple
Z)

кT :: [(Char, Triple)] -> (Char, Triple)
кT :: [(Char, Triple)] -> (Char, Triple)
кT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'g', Triple
Z)
            | Bool
otherwise = (Char
'k', Triple
Z)
кT [(Char, Triple)]
_ = (Char
'k', Triple
Z)

нтT :: [(Char, Triple)] -> (Char, Triple)
нтT :: [(Char, Triple)] -> (Char, Triple)
нтT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
2 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"st" Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
1 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"O" = (Char
'n', Triple
Z)
             | Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
3 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"sqk" Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
2 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"Dk" = (Char
'S', Triple
T)
             | Bool
otherwise = (Char
'N', Triple
T)
нтT [(Char, Triple)]
_ = (Char
'N', Triple
T)

пT :: [(Char, Triple)] -> (Char, Triple)
пT :: [(Char, Triple)] -> (Char, Triple)
пT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'b', Triple
Z)
            | Bool
otherwise = (Char
'p', Triple
Z)
пT [(Char, Triple)]
_ = (Char
'p', Triple
Z)

сT :: [(Char, Triple)] -> (Char, Triple)
сT :: [(Char, Triple)] -> (Char, Triple)
сT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ((ByteString -> Bool
isVoicedObstruentH (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1) Bool -> Bool -> Bool
&& Int -> ByteString -> ByteString
B.drop Int
1 (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"q") Bool -> Bool -> Bool
|| ByteString -> Bool
isVoicedObstruentS (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1) = (Char
'R', Triple
T)
            | ByteString -> Bool
isVoicedObstruentH (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'z', Triple
Z)
            | [(Char, Triple)] -> Bool
isSoftDOrL [(Char, Triple)]
t1 = (Char
'D', Triple
Z)
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"F" = (Char
'F', Triple
Z)
            | Bool
otherwise = (Char
's', Triple
Z)
сT [(Char, Triple)]
_ = (Char
's', Triple
Z)

стT :: [(Char, Triple)] -> (Char, Triple)
стT :: [(Char, Triple)] -> (Char, Triple)
стT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1  = (Char
'z', Triple
Z)
             | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
3 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"sqk" Bool -> Bool -> Bool
|| (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"Dk",ByteString
"cq"]) Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"w" = (Char
'D', Triple
Z)
             | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"s",ByteString
"n"] = (Char
's', Triple
Z)
             | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"E" = (Char
'F', Triple
Z)
             | Bool
otherwise = (Char
'O', Triple
T)
стT [(Char, Triple)]
_ = (Char
'O', Triple
T)

сьT :: [(Char, Triple)] -> (Char, Triple)
сьT :: [(Char, Triple)] -> (Char, Triple)
сьT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'R', Triple
T)
             | Bool
otherwise = (Char
'D', Triple
Z)
сьT [(Char, Triple)]
_ = (Char
'D', Triple
Z)

тT :: [(Char, Triple)] -> (Char, Triple)
тT :: [(Char, Triple)] -> (Char, Triple)
тT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ((ByteString -> Bool
isVoicedObstruentH (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1) Bool -> Bool -> Bool
&& Int -> ByteString -> ByteString
B.drop Int
1 (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"q") Bool -> Bool -> Bool
|| ByteString -> Bool
isVoicedObstruentS (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1) = (Char
'T', Triple
T)
            | ByteString -> Bool
isVoicedObstruentH (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'd', Triple
Z)
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"cq" Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"w"  = (Char
'w', Triple
Z)
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"c" = (Char
'c', Triple
Z)
            | [(Char, Triple)] -> Bool
isSoftDen [(Char, Triple)]
t1 = (Char
'P', Triple
T)
            | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"E",ByteString
"F"] = (Char
'E', Triple
Z)
            | Bool
otherwise = (Char
't', Triple
Z)
тT [(Char, Triple)]
_ = (Char
't', Triple
Z)

тьT :: [(Char, Triple)] -> (Char, Triple)
тьT :: [(Char, Triple)] -> (Char, Triple)
тьT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'T', Triple
T)
             | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
3 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"sqa" Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"Da" = (Char
'w', Triple
Z)
             | Bool
otherwise = (Char
'P', Triple
T)
тьT [(Char, Triple)]
_ = (Char
'P', Triple
T)

фT :: [(Char, Triple)] -> (Char, Triple)
фT :: [(Char, Triple)] -> (Char, Triple)
фT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'v', Triple
Z)
            | Bool
otherwise = (Char
'f', Triple
Z)
фT [(Char, Triple)]
_ = (Char
'f', Triple
Z)

хT :: [(Char, Triple)] -> (Char, Triple)
хT :: [(Char, Triple)] -> (Char, Triple)
хT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'h', Triple
Z)
            | Bool
otherwise = (Char
'x', Triple
Z)
хT [(Char, Triple)]
_ = (Char
'х', Triple
Z)

цT :: [(Char, Triple)] -> (Char, Triple)
цT :: [(Char, Triple)] -> (Char, Triple)
цT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | ((ByteString -> Bool
isVoicedObstruentH (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1) Bool -> Bool -> Bool
&& Int -> ByteString -> ByteString
B.drop Int
1 (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"q") Bool -> Bool -> Bool
|| ByteString -> Bool
isVoicedObstruentS (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1) = (Char
'Q', Triple
T)
            | [(Char, Triple)] -> Bool
isSoftDOrL [(Char, Triple)]
t1 = (Char
'w', Triple
Z)
            | ByteString -> Bool
isVoicedObstruentH (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'A', Triple
Z)
            | Bool
otherwise = (Char
'c', Triple
Z)
цT [(Char, Triple)]
_ = (Char
'c', Triple
Z)

цьT :: [(Char, Triple)] -> (Char, Triple)
цьT :: [(Char, Triple)] -> (Char, Triple)
цьT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | (ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1) Bool -> Bool -> Bool
&& Int -> ByteString -> ByteString
B.drop Int
1 (Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"q" = (Char
'Q', Triple
T)
             | Bool
otherwise = (Char
'w', Triple
Z)
цьT [(Char, Triple)]
_ = (Char
'w', Triple
Z)

чT :: [(Char, Triple)] -> (Char, Triple)
чT :: [(Char, Triple)] -> (Char, Triple)
чT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"sq",ByteString
"cq"] Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"D",ByteString
"w"] = (Char
'w', Triple
Z)
            | ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'j', Triple
Z)
            | Bool
otherwise = (Char
'E', Triple
Z)
чT [(Char, Triple)]
_ = (Char
'E', Triple
Z)

шT :: [(Char, Triple)] -> (Char, Triple)
шT :: [(Char, Triple)] -> (Char, Triple)
шT t1 :: [(Char, Triple)]
t1@((Char, Triple)
_:[(Char, Triple)]
_) | Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
2 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"sq",ByteString
"cq"] Bool -> Bool -> Bool
|| Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 [(Char, Triple)]
t1 ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"D",ByteString
"w"] = (Char
'D', Triple
Z)
            | ByteString -> Bool
isVoicedObstruent (ByteString -> Bool)
-> ([(Char, Triple)] -> ByteString) -> [(Char, Triple)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
1 ([(Char, Triple)] -> Bool) -> [(Char, Triple)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Char, Triple)]
t1 = (Char
'B', Triple
Z)
            | Bool
otherwise = (Char
'F', Triple
Z)
шT [(Char, Triple)]
_ = (Char
'F', Triple
Z)

takeFromFT :: Int -> [(Char, Triple)] -> B.ByteString
takeFromFT :: Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
n [(Char, Triple)]
ts | if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
0 Int
n Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT then Bool
True else [(Char, Triple)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Char, Triple)]
ts = ByteString
B.empty
                | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
1 Int
n Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT = Char -> ByteString
B.singleton Char
k
                | Bool
otherwise = Char
k Char -> ByteString -> ByteString
`B.cons` Int -> [(Char, Triple)] -> ByteString
takeFromFT (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> [(Char, Triple)] -> [(Char, Triple)]
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(Char, Triple)]
ts)
    where k :: Char
k = (Char, Triple) -> Char
forall a b. (a, b) -> a
fst ([(Char, Triple)] -> (Char, Triple)
forall a. [a] -> a
head [(Char, Triple)]
ts)

takeFromFT2 :: Int -> [Char] -> [Char]
takeFromFT2 :: Int -> ShowS
takeFromFT2 Int
n String
ts | if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
0 Int
n Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT then Bool
True else String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ts = []
                 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
1 Int
n Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT = [Char
ks]
                 | Bool
otherwise = Char
ksChar -> ShowS
forall a. a -> [a] -> [a]
:Int -> ShowS
takeFromFT2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (ShowS
forall a. [a] -> [a]
tail String
ts)
    where ks :: Char
ks = String -> Char
forall a. [a] -> a
head String
ts

dropFromFT2 :: Int -> [Char] -> [Char]
dropFromFT2 :: Int -> ShowS
dropFromFT2 Int
n String
ts | if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
0 Int
n Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT then Bool
True else String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ts = []
                 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
1 Int
n Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT = ShowS
forall a. [a] -> [a]
tail String
ts
                 | Bool
otherwise = Int -> ShowS
dropFromFT2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (ShowS
forall a. [a] -> [a]
tail String
ts)

takeFromFT_ :: Int -> [(Char, Triple)] -> B.ByteString
takeFromFT_ :: Int -> [(Char, Triple)] -> ByteString
takeFromFT_ Int
n = Int -> [(Char, Triple)] -> ByteString
takeFromFT Int
n ([(Char, Triple)] -> ByteString)
-> ([(Char, Triple)] -> [(Char, Triple)])
-> [(Char, Triple)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Triple) -> Bool) -> [(Char, Triple)] -> [(Char, Triple)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Char
x, Triple
_) -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'1' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0')

correctA :: [(Char, Triple)] -> [Char]
correctA :: [(Char, Triple)] -> String
correctA = ShowS
correctSomeW ShowS -> ([(Char, Triple)] -> String) -> [(Char, Triple)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Triple)] -> String
separateSoftS

separateSoftS :: [(Char, Triple)] -> [Char]
separateSoftS :: [(Char, Triple)] -> String
separateSoftS = ((Char, Triple) -> String) -> [(Char, Triple)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Char, Triple) -> String
divideToParts

correctSomeW :: [Char] -> [Char]
correctSomeW :: ShowS
correctSomeW (Char
x:Char
y:Char
z:xs :: String
xs@(Char
t:String
ys))
 | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
't' Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'q' Bool -> Bool -> Bool
&& Char
z Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D' Bool -> Bool -> Bool
&& Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a' = Char
'w'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'w'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'a'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
correctSomeW String
ys
 | (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'C' Bool -> Bool -> Bool
&& Char
z Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a' =
  if Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
2 String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"En"
    then Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:Char
yChar -> ShowS
forall a. a -> [a] -> [a]
:Char
zChar -> ShowS
forall a. a -> [a] -> [a]
:Char
'F'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
correctSomeW String
ys
    else Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
correctSomeW (Char
yChar -> ShowS
forall a. a -> [a] -> [a]
:Char
zChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                        | Bool
otherwise = Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
correctSomeW (Char
yChar -> ShowS
forall a. a -> [a] -> [a]
:Char
zChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
correctSomeW String
zs = String
zs

divideToParts :: (Char, Triple) -> [Char]
divideToParts :: (Char, Triple) -> String
divideToParts (Char
x, Triple
z) = String -> [(Char, String)] -> Char -> String
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' [Char
x] (String -> [String] -> [(Char, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"NOPQRST" [String
"nt", String
"st", String
"tq", String
"Aq", String
"zq", String
"nq", String
"dq"]) (Char -> String)
-> ((Char, Triple) -> Char) -> (Char, Triple) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Triple) -> Char
forall a b. (a, b) -> a
fst ((Char, Triple) -> String) -> (Char, Triple) -> String
forall a b. (a -> b) -> a -> b
$ (Char
x, Triple
z)

correctB :: [Char] -> [Char]
correctB :: ShowS
correctB ys :: String
ys@(Char
x:String
xs)
  | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
takeFromFT2 Int
6 (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
ys) Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
t -> if Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1' Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
t then Char
'-' else Char
t) (Int -> ShowS
takeFromFT2 Int
6 String
ys) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
correctB (Int -> ShowS
dropFromFT2 Int
6 String
ys)
  | Bool
otherwise = (if Char -> Bool
isPunctuation Char
x then Char
'-' else Char
x)Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
correctB String
xs
correctB String
_ = []

-- | A variant of the 'convertToProperUkrainian' with the 'B.ByteString' result.
convertToProperUkrainianB :: String -> B.ByteString
convertToProperUkrainianB :: String -> ByteString
convertToProperUkrainianB = String -> ByteString
B.pack (String -> ByteString) -> ShowS -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
convertToProperUkrainianS

linkFileName :: Char -> Char
linkFileName :: Char -> Char
linkFileName Char
x = Char -> [(Char, Char)] -> Char -> Char
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Char
x (String -> String -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"ABCDEFLMabcdefghijklmnopqrstuvwxyz" String
"GILUbc00ABZEHXfDeFMNOPQRdSTVWCaYKJ") Char
x

showInteresting :: String -> B.ByteString
showInteresting :: String -> ByteString
showInteresting = String -> ByteString
forall a. IsString a => String -> a
S.fromString (String -> ByteString) -> ShowS -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
convertToProperUkrainianS