{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}

-- |
-- Module      :  Phonetic.Languages.General.DeEnCoding
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Functions to encode and decode 'String' -> \['Int8'\] used in the Simple/Main.hs code.
-- Firstly were taken from the @phonetic-languages-simplified-lists-examples@ package.
-- Is modified from the module Phonetic.Languages.Simplified.DeEnCoding from the
-- @phonetic-languages-simplified-examples-common@ package.

module Phonetic.Languages.General.DeEnCoding where

import Data.Heap (Heap)
import qualified Data.Heap as Heap
import GHC.Int
import Data.Foldable (foldl')
import Data.List (sortBy,sort,partition)
import System.IO
import Data.Maybe (fromJust)
import Numeric
import Phonetic.Languages.EmphasisG
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
--import Phonetic.Languages.Coeffs

--default (Int, Double)

encodeToInt :: Ord a => [[a]] -> Int
encodeToInt :: forall a. Ord a => [[a]] -> Int
encodeToInt [[a]]
yss
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, String)]
ks = -Int
1
 | Bool
otherwise = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [(Int, String)]
ks
  where ks :: [(Int, String)]
ks = forall a. (Eq a, Num a) => ReadS a
readHex (forall a. (Integral a, Show a) => a -> ShowS
showHex (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
x Int
y -> Int
x forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ Int
y) Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Int8
j,[a]
_) -> forall a. Enum a => a -> Int
fromEnum Int8
j) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int8, [a])
x (Int8, [a])
y -> forall a. Ord a => a -> a -> Ordering
compare (forall a b. (a, b) -> b
snd (Int8, [a])
x) (forall a b. (a, b) -> b
snd (Int8, [a])
y)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [(Int8, [a])]
trans2 forall a b. (a -> b) -> a -> b
$ [[a]]
yss) forall a b. (a -> b) -> a -> b
$ String
"")
{-# INLINABLE encodeToInt #-}


-- | Is taken mostly from the Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG module from the @phonetic-languages-simplified-common@ package.
indexedL :: Foldable t => b -> t b -> [(Int8, b)]
indexedL :: forall (t :: * -> *) b. Foldable t => b -> t b -> [(Int8, b)]
indexedL b
y t b
zs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b}. Num a => b -> [(a, b)] -> [(a, b)]
f [(Int8, b)]
v t b
zs
  where !v :: [(Int8, b)]
v = [(forall a. Enum a => Int -> a
toEnum (forall (t :: * -> *) a. Foldable t => t a -> Int
length t b
zs forall a. Num a => a -> a -> a
+ Int
1),b
y)]
        f :: b -> [(a, b)] -> [(a, b)]
f b
x ((a
j,b
z):[(a, b)]
ys) = (a
jforall a. Num a => a -> a -> a
-a
1,b
x)forall a. a -> [a] -> [a]
:(a
j,b
z)forall a. a -> [a] -> [a]
:[(a, b)]
ys
{-# INLINE indexedL #-}

trans2 :: [[a]] -> [(Int8, [a])]
trans2 :: forall a. [[a]] -> [(Int8, [a])]
trans2 = forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b. Foldable t => b -> t b -> [(Int8, b)]
indexedL []
{-# INLINE trans2 #-}

trans232 :: [[a]] -> [(Int, [a])]
trans232 :: forall a. [[a]] -> [(Int, [a])]
trans232 [[a]]
zs = forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b}. Num a => b -> [(a, b)] -> [(a, b)]
f forall {a}. [(Int, [a])]
v forall a b. (a -> b) -> a -> b
$ [[a]]
zs
  where !v :: [(Int, [a])]
v = [(forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
zs forall a. Num a => a -> a -> a
+ Int
1,[])]
        f :: b -> [(a, b)] -> [(a, b)]
f b
x ((a
j,b
z):[(a, b)]
ys) = (a
jforall a. Num a => a -> a -> a
-a
1,b
x)forall a. a -> [a] -> [a]
:(a
j,b
z)forall a. a -> [a] -> [a]
:[(a, b)]
ys
{-# INLINE trans232 #-}

int2l :: Int -> [Int8]
int2l :: Int -> [Int8]
int2l Int
n
 | Int
n forall a. Ord a => a -> a -> Bool
< Int
16 = [forall a. Enum a => Int -> a
toEnum Int
n]
 | Bool
otherwise = Int -> [Int8]
int2l Int
n1 forall a. Monoid a => a -> a -> a
`mappend` [Int8
l]
     where (!Int
n1,!Int
l0) = forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
16
           !l :: Int8
l = forall a. Enum a => Int -> a
toEnum Int
l0
{-# INLINABLE int2l #-}

-- | So for the strings consisting of no more than 10 words:
-- > decodeToStr (int2l . encodeToInt . words $ xs) xs == unwords . words $ xs
--
decodeToStr :: [Int8] -> String -> String
decodeToStr :: [Int8] -> ShowS
decodeToStr [Int8]
ys = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int8, String)
x (Int8, String)
y -> forall a. Ord a => a -> a -> Ordering
compare (forall a b. (a, b) -> a
fst (Int8, String)
x) (forall a b. (a, b) -> a
fst (Int8, String)
y)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int8]
ys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
{-# INLINE decodeToStr #-}

-- | For the 'ReadyForConstructionUkr' that corresponds to the 'String' consisting of no more than 10 words.
--
decodeToReadyFCPL :: [Int8] -> ReadyForConstructionPL -> ReadyForConstructionPL
decodeToReadyFCPL :: [Int8] -> ReadyForConstructionPL -> ReadyForConstructionPL
decodeToReadyFCPL [Int8]
ys (StrG String
ts) = String -> ReadyForConstructionPL
StrG forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int8, String)
x (Int8, String)
y -> forall a. Ord a => a -> a -> Ordering
compare (forall a b. (a, b) -> a
fst (Int8, String)
x) (forall a b. (a, b) -> a
fst (Int8, String)
y)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int8]
ys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
ts
decodeToReadyFCPL [Int8]
ys (FSLG [[[Int8]]]
tsss) = [[[Int8]]] -> ReadyForConstructionPL
FSLG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int8, [[Int8]])
x (Int8, [[Int8]])
y -> forall a. Ord a => a -> a -> Ordering
compare (forall a b. (a, b) -> a
fst (Int8, [[Int8]])
x) (forall a b. (a, b) -> a
fst (Int8, [[Int8]])
y)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int8]
ys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ [[[Int8]]]
tsss
{-# INLINE decodeToReadyFCPL #-}

-- | Every 'String' consists of words with whitespace symbols in between.
toHeap :: [String] -> Heap Int
toHeap :: [String] -> Heap Int
toHeap yss :: [String]
yss@(String
xs:[String]
xss)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = forall a. Ord a => a -> Heap a
Heap.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [[a]] -> Int
encodeToInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
xs
  | Bool
otherwise = forall a. Ord a => [a] -> Heap a
Heap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => [[a]] -> Int
encodeToInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) forall a b. (a -> b) -> a -> b
$ [String]
yss
toHeap [String]
_ = forall a. Heap a
Heap.empty
{-# INLINE toHeap #-}

-- | Every 'ReadyForConstructionUkr' corresponds to the 'String' that consists of words with whitespace symbols in between.
-- The list must be consistent -- either 'FSL'-constructed or 'Str'-constructed.
toHeapR :: [ReadyForConstructionPL] -> Heap Int
toHeapR :: [ReadyForConstructionPL] -> Heap Int
toHeapR yss :: [ReadyForConstructionPL]
yss@(xs :: ReadyForConstructionPL
xs@(StrG String
ts):[ReadyForConstructionPL]
xss)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionPL]
xss = forall a. Ord a => a -> Heap a
Heap.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [[a]] -> Int
encodeToInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
ts
  | Bool
otherwise = forall a. Ord a => [a] -> Heap a
Heap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => [[a]] -> Int
encodeToInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionPL -> Maybe String
fromReadyFCPLS) forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
yss
toHeapR yss :: [ReadyForConstructionPL]
yss@(xs :: ReadyForConstructionPL
xs@(FSLG [[[Int8]]]
tsss):[ReadyForConstructionPL]
xss)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionPL]
xss = forall a. Ord a => a -> Heap a
Heap.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [[a]] -> Int
encodeToInt forall a b. (a -> b) -> a -> b
$ [[[Int8]]]
tsss
  | Bool
otherwise = forall a. Ord a => [a] -> Heap a
Heap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => [[a]] -> Int
encodeToInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionPL -> Maybe [[[Int8]]]
fromReadyFCPLF) forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
yss  
toHeapR [ReadyForConstructionPL]
_ = forall a. Heap a
Heap.empty
{-# INLINE toHeapR #-}

fromHeap :: String -> Heap Int -> [String]
fromHeap :: String -> Heap Int -> [String]
fromHeap String
ys Heap Int
heap
 | forall a. Heap a -> Bool
Heap.null Heap Int
heap = []
 | Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip [Int8] -> ShowS
decodeToStr String
ys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int8]
int2l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> [a]
Heap.toUnsortedList forall a b. (a -> b) -> a -> b
$ Heap Int
heap
{-# INLINE fromHeap #-}

fromHeapReadyFCPL :: ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL :: ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL ReadyForConstructionPL
ys Heap Int
heap
 | forall a. Heap a -> Bool
Heap.null Heap Int
heap = []
 | Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip [Int8] -> ReadyForConstructionPL -> ReadyForConstructionPL
decodeToReadyFCPL ReadyForConstructionPL
ys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int8]
int2l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> [a]
Heap.toUnsortedList forall a b. (a -> b) -> a -> b
$ Heap Int
heap
{-# INLINE fromHeapReadyFCPL #-}

intersectInterResults :: [String] -> [String] -> [String]
intersectInterResults :: [String] -> [String] -> [String]
intersectInterResults [String]
zss
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
zss = forall a b. a -> b -> a
const []
 | Bool
otherwise = String -> Heap Int -> [String]
fromHeap (forall a. [a] -> a
head [String]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([String] -> Heap Int
toHeap [String]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Heap Int
toHeap
{-# INLINE intersectInterResults #-}

-- | It seems like it works, but it isn't. (??). The main reason is the hardness with defining convF to work properly.
intersectInterReadyFCPL :: (String -> [[[Int8]]]) -> [ReadyForConstructionPL] -> [ReadyForConstructionPL] -> [ReadyForConstructionPL]
intersectInterReadyFCPL :: (String -> [[[Int8]]])
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
intersectInterReadyFCPL String -> [[[Int8]]]
convF [ReadyForConstructionPL]
zss [ReadyForConstructionPL]
tss
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionPL]
zss = []
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionPL]
tss = []
 | (ReadyForConstructionPL -> Bool
isStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss) Bool -> Bool -> Bool
&& (ReadyForConstructionPL -> Bool
isStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
zss) = ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL (forall a. [a] -> a
head [ReadyForConstructionPL]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionPL] -> Heap Int
toHeapR [ReadyForConstructionPL]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> Heap Int
toHeapR forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss
 | (ReadyForConstructionPL -> Bool
isFSL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss) Bool -> Bool -> Bool
&& (ReadyForConstructionPL -> Bool
isFSL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
zss) = ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL (forall a. [a] -> a
head [ReadyForConstructionPL]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionPL] -> Heap Int
toHeapR [ReadyForConstructionPL]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> Heap Int
toHeapR forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss
 | ReadyForConstructionPL -> Bool
isStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss = ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL (forall a. [a] -> a
head [ReadyForConstructionPL]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionPL] -> Heap Int
toHeapR [ReadyForConstructionPL]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> Heap Int
toHeapR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> ReadyForConstructionPL
FSLG forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Int8]]]
convF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionPL -> Maybe String
fromReadyFCPLS) forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss
 | Bool
otherwise = ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL (forall a. [a] -> a
head [ReadyForConstructionPL]
tss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionPL] -> Heap Int
toHeapR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> ReadyForConstructionPL
FSLG forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Int8]]]
convF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionPL -> Maybe String
fromReadyFCPLS) forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> Heap Int
toHeapR forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss
{-# INLINE intersectInterReadyFCPL #-}

intersectInterReadyFCPL2 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> [ReadyForConstructionPL] 
  -> [ReadyForConstructionPL] 
  -> [ReadyForConstructionPL]
intersectInterReadyFCPL2 :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
intersectInterReadyFCPL2 GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts = (String -> [[[Int8]]])
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
intersectInterReadyFCPL (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> String
-> [[[Int8]]]
convFI GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts)
{-# INLINE intersectInterReadyFCPL2 #-}

-- | Auxiliary printing function to define the line ending in some cases. Is taken from the
-- Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package
newLineEnding :: String
newLineEnding :: String
newLineEnding
  | Newline
nativeNewline forall a. Eq a => a -> a -> Bool
== Newline
LF = String
"\n"
  | Bool
otherwise = String
"\r\n"

  
foldlI 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> [[ReadyForConstructionPL]] 
  -> [ReadyForConstructionPL]
foldlI :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[ReadyForConstructionPL]]
-> [ReadyForConstructionPL]
foldlI GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts jss :: [[ReadyForConstructionPL]]
jss@((![ReadyForConstructionPL]
xs):[ReadyForConstructionPL]
ys:[[ReadyForConstructionPL]]
xss) 
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ReadyForConstructionPL]]
pss = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[ReadyForConstructionPL]]
-> [ReadyForConstructionPL]
foldlI' GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts [[ReadyForConstructionPL]]
qss
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ReadyForConstructionPL]]
qss = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[ReadyForConstructionPL]]
-> [ReadyForConstructionPL]
foldlI' GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts [[ReadyForConstructionPL]]
pss
 | Bool
otherwise = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
intersectInterReadyFCPL2 GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[ReadyForConstructionPL]]
-> [ReadyForConstructionPL]
foldlI' GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts [[ReadyForConstructionPL]]
pss) (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[ReadyForConstructionPL]]
-> [ReadyForConstructionPL]
foldlI' GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts [[ReadyForConstructionPL]]
qss) 
  where ([[ReadyForConstructionPL]]
pss,[[ReadyForConstructionPL]]
qss) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Ord a => a -> a -> Bool
< [[[[Int8]]] -> ReadyForConstructionPL
FSLG []]) [[ReadyForConstructionPL]]
jss
        foldlI' :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[ReadyForConstructionPL]]
-> [ReadyForConstructionPL]
foldlI' GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts rss :: [[ReadyForConstructionPL]]
rss@([ReadyForConstructionPL]
rs:[ReadyForConstructionPL]
ps:[[ReadyForConstructionPL]]
yss) = GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[ReadyForConstructionPL]]
-> [ReadyForConstructionPL]
foldlI' GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
intersectInterReadyFCPL2 GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts [ReadyForConstructionPL]
rs [ReadyForConstructionPL]
ps forall a. a -> [a] -> [a]
: [[ReadyForConstructionPL]]
yss)
        foldlI' GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
ts ((![ReadyForConstructionPL]
xs):[[ReadyForConstructionPL]]
_) = [ReadyForConstructionPL]
xs
        foldlI' GWritingSystemPRPLX
_ [(Char, Char)]
_ CharPhoneticClassification
_ SegmentRulesG
_ String
_ String
_ String
_ [[ReadyForConstructionPL]]
_ = []
foldlI GWritingSystemPRPLX
_ [(Char, Char)]
_ CharPhoneticClassification
_ SegmentRulesG
_ String
_ String
_ String
_ ((![ReadyForConstructionPL]
xs):[[ReadyForConstructionPL]]
_) = [ReadyForConstructionPL]
xs
foldlI GWritingSystemPRPLX
_ [(Char, Char)]
_ CharPhoneticClassification
_ SegmentRulesG
_ String
_ String
_ String
_ [[ReadyForConstructionPL]]
_ = []