{-# 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 Melodics.Ukrainian.ArrInt8 (FlowSound)
--import Languages.Phonetic.Ukrainian.Syllable.ArrInt8
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables

--default (Int, Double)

encodeToInt :: Ord a => [[a]] -> Int
encodeToInt :: [[a]] -> Int
encodeToInt [[a]]
yss
 | [(Int, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, String)]
ks = -Int
1
 | Bool
otherwise = (Int, String) -> Int
forall a b. (a, b) -> a
fst ((Int, String) -> Int)
-> ([(Int, String)] -> (Int, String)) -> [(Int, String)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, String)] -> (Int, String)
forall a. [a] -> a
head ([(Int, String)] -> Int) -> [(Int, String)] -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, String)]
ks
  where ks :: [(Int, String)]
ks = ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex (Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex ((Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
x Int
y -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Int
0 ([Int] -> Int) -> ([[a]] -> [Int]) -> [[a]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, [a]) -> Int) -> [(Int8, [a])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int8
j,[a]
_) -> Int8 -> Int
forall a. Enum a => a -> Int
fromEnum Int8
j) ([(Int8, [a])] -> [Int])
-> ([[a]] -> [(Int8, [a])]) -> [[a]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, [a]) -> (Int8, [a]) -> Ordering)
-> [(Int8, [a])] -> [(Int8, [a])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int8, [a])
x (Int8, [a])
y -> [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int8, [a]) -> [a]
forall a b. (a, b) -> b
snd (Int8, [a])
x) ((Int8, [a]) -> [a]
forall a b. (a, b) -> b
snd (Int8, [a])
y)) ([(Int8, [a])] -> [(Int8, [a])])
-> ([[a]] -> [(Int8, [a])]) -> [[a]] -> [(Int8, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [(Int8, [a])]
forall a. [[a]] -> [(Int8, [a])]
trans2 ([[a]] -> Int) -> [[a]] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]]
yss) ShowS -> ShowS
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 :: b -> t b -> [(Int8, b)]
indexedL b
y t b
zs = (b -> [(Int8, b)] -> [(Int8, b)])
-> [(Int8, b)] -> t b -> [(Int8, b)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> [(Int8, b)] -> [(Int8, b)]
forall a b. Num a => b -> [(a, b)] -> [(a, b)]
f [(Int8, b)]
v t b
zs
  where !v :: [(Int8, b)]
v = [(Int -> Int8
forall a. Enum a => Int -> a
toEnum (t b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t b
zs Int -> Int -> Int
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
ja -> a -> a
forall a. Num a => a -> a -> a
-a
1,b
x)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:(a
j,b
z)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
ys
{-# INLINE indexedL #-}

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

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

int2l :: Int -> [Int8]
int2l :: Int -> [Int8]
int2l Int
n
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16 = [Int -> Int8
forall a. Enum a => Int -> a
toEnum Int
n]
 | Bool
otherwise = Int -> [Int8]
int2l Int
n1 [Int8] -> [Int8] -> [Int8]
forall a. Monoid a => a -> a -> a
`mappend` [Int8
l]
     where (!Int
n1,!Int
l0) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
16
           !l :: Int8
l = Int -> Int8
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 ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, String) -> String) -> [(Int8, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int8, String) -> String
forall a b. (a, b) -> b
snd ([(Int8, String)] -> [String])
-> (String -> [(Int8, String)]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, String) -> (Int8, String) -> Ordering)
-> [(Int8, String)] -> [(Int8, String)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int8, String)
x (Int8, String)
y -> Int8 -> Int8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int8, String) -> Int8
forall a b. (a, b) -> a
fst (Int8, String)
x) ((Int8, String) -> Int8
forall a b. (a, b) -> a
fst (Int8, String)
y)) ([(Int8, String)] -> [(Int8, String)])
-> (String -> [(Int8, String)]) -> String -> [(Int8, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int8] -> [String] -> [(Int8, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int8]
ys ([String] -> [(Int8, String)])
-> (String -> [String]) -> String -> [(Int8, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String])
-> (String -> [String]) -> String -> [String]
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 (String -> ReadyForConstructionPL)
-> ShowS -> String -> ReadyForConstructionPL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, String) -> String) -> [(Int8, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int8, String) -> String
forall a b. (a, b) -> b
snd ([(Int8, String)] -> [String])
-> (String -> [(Int8, String)]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, String) -> (Int8, String) -> Ordering)
-> [(Int8, String)] -> [(Int8, String)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int8, String)
x (Int8, String)
y -> Int8 -> Int8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int8, String) -> Int8
forall a b. (a, b) -> a
fst (Int8, String)
x) ((Int8, String) -> Int8
forall a b. (a, b) -> a
fst (Int8, String)
y)) ([(Int8, String)] -> [(Int8, String)])
-> (String -> [(Int8, String)]) -> String -> [(Int8, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int8] -> [String] -> [(Int8, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int8]
ys ([String] -> [(Int8, String)])
-> (String -> [String]) -> String -> [(Int8, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> ReadyForConstructionPL)
-> String -> ReadyForConstructionPL
forall a b. (a -> b) -> a -> b
$ String
ts
decodeToReadyFCPL [Int8]
ys (FSLG [[[Int8]]]
tsss) = [[[Int8]]] -> ReadyForConstructionPL
FSLG ([[[Int8]]] -> ReadyForConstructionPL)
-> ([[[Int8]]] -> [[[Int8]]])
-> [[[Int8]]]
-> ReadyForConstructionPL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, [[Int8]]) -> [[Int8]]) -> [(Int8, [[Int8]])] -> [[[Int8]]]
forall a b. (a -> b) -> [a] -> [b]
map (Int8, [[Int8]]) -> [[Int8]]
forall a b. (a, b) -> b
snd ([(Int8, [[Int8]])] -> [[[Int8]]])
-> ([[[Int8]]] -> [(Int8, [[Int8]])]) -> [[[Int8]]] -> [[[Int8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, [[Int8]]) -> (Int8, [[Int8]]) -> Ordering)
-> [(Int8, [[Int8]])] -> [(Int8, [[Int8]])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int8, [[Int8]])
x (Int8, [[Int8]])
y -> Int8 -> Int8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int8, [[Int8]]) -> Int8
forall a b. (a, b) -> a
fst (Int8, [[Int8]])
x) ((Int8, [[Int8]]) -> Int8
forall a b. (a, b) -> a
fst (Int8, [[Int8]])
y)) ([(Int8, [[Int8]])] -> [(Int8, [[Int8]])])
-> ([[[Int8]]] -> [(Int8, [[Int8]])])
-> [[[Int8]]]
-> [(Int8, [[Int8]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int8] -> [[[Int8]]] -> [(Int8, [[Int8]])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int8]
ys ([[[Int8]]] -> [(Int8, [[Int8]])])
-> ([[[Int8]]] -> [[[Int8]]]) -> [[[Int8]]] -> [(Int8, [[Int8]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Int8]]] -> [[[Int8]]]
forall a. Ord a => [a] -> [a]
sort ([[[Int8]]] -> ReadyForConstructionPL)
-> [[[Int8]]] -> ReadyForConstructionPL
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)
  | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = Int -> Heap Int
forall a. Ord a => a -> Heap a
Heap.singleton (Int -> Heap Int) -> (String -> Int) -> String -> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int
forall a. Ord a => [[a]] -> Int
encodeToInt ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Heap Int) -> String -> Heap Int
forall a b. (a -> b) -> a -> b
$ String
xs
  | Bool
otherwise = [Int] -> Heap Int
forall a. Ord a => [a] -> Heap a
Heap.fromList ([Int] -> Heap Int) -> ([String] -> [Int]) -> [String] -> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Int
forall a. Ord a => [[a]] -> Int
encodeToInt ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) ([String] -> Heap Int) -> [String] -> Heap Int
forall a b. (a -> b) -> a -> b
$ [String]
yss
toHeap [String]
_ = Heap Int
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)
  | [ReadyForConstructionPL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionPL]
xss = Int -> Heap Int
forall a. Ord a => a -> Heap a
Heap.singleton (Int -> Heap Int) -> (String -> Int) -> String -> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int
forall a. Ord a => [[a]] -> Int
encodeToInt ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Heap Int) -> String -> Heap Int
forall a b. (a -> b) -> a -> b
$ String
ts
  | Bool
otherwise = [Int] -> Heap Int
forall a. Ord a => [a] -> Heap a
Heap.fromList ([Int] -> Heap Int)
-> ([ReadyForConstructionPL] -> [Int])
-> [ReadyForConstructionPL]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL -> Int)
-> [ReadyForConstructionPL] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Int
forall a. Ord a => [[a]] -> Int
encodeToInt ([String] -> Int)
-> (ReadyForConstructionPL -> [String])
-> ReadyForConstructionPL
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String])
-> (ReadyForConstructionPL -> String)
-> ReadyForConstructionPL
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (ReadyForConstructionPL -> Maybe String)
-> ReadyForConstructionPL
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionPL -> Maybe String
fromReadyFCPLS) ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL] -> Heap Int
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
yss
toHeapR yss :: [ReadyForConstructionPL]
yss@(xs :: ReadyForConstructionPL
xs@(FSLG [[[Int8]]]
tsss):[ReadyForConstructionPL]
xss)
  | [ReadyForConstructionPL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionPL]
xss = Int -> Heap Int
forall a. Ord a => a -> Heap a
Heap.singleton (Int -> Heap Int) -> ([[[Int8]]] -> Int) -> [[[Int8]]] -> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Int8]]] -> Int
forall a. Ord a => [[a]] -> Int
encodeToInt ([[[Int8]]] -> Heap Int) -> [[[Int8]]] -> Heap Int
forall a b. (a -> b) -> a -> b
$ [[[Int8]]]
tsss
  | Bool
otherwise = [Int] -> Heap Int
forall a. Ord a => [a] -> Heap a
Heap.fromList ([Int] -> Heap Int)
-> ([ReadyForConstructionPL] -> [Int])
-> [ReadyForConstructionPL]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL -> Int)
-> [ReadyForConstructionPL] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> Int
forall a. Ord a => [[a]] -> Int
encodeToInt ([[[Int8]]] -> Int)
-> (ReadyForConstructionPL -> [[[Int8]]])
-> ReadyForConstructionPL
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [[[Int8]]] -> [[[Int8]]]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [[[Int8]]] -> [[[Int8]]])
-> (ReadyForConstructionPL -> Maybe [[[Int8]]])
-> ReadyForConstructionPL
-> [[[Int8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionPL -> Maybe [[[Int8]]]
fromReadyFCPLF) ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL] -> Heap Int
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
yss  
toHeapR [ReadyForConstructionPL]
_ = Heap Int
forall a. Heap a
Heap.empty
{-# INLINE toHeapR #-}

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

intersectInterResults :: [String] -> [String] -> [String]
intersectInterResults :: [String] -> [String] -> [String]
intersectInterResults [String]
zss
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
zss = [String] -> [String] -> [String]
forall a b. a -> b -> a
const []
 | Bool
otherwise = String -> Heap Int -> [String]
fromHeap ([String] -> String
forall a. [a] -> a
head [String]
zss) (Heap Int -> [String])
-> ([String] -> Heap Int) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap Int -> Heap Int -> Heap Int
forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([String] -> Heap Int
toHeap [String]
zss) (Heap Int -> Heap Int)
-> ([String] -> Heap Int) -> [String] -> Heap Int
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
 | [ReadyForConstructionPL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionPL]
zss = []
 | [ReadyForConstructionPL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionPL]
tss = []
 | (ReadyForConstructionPL -> Bool
isStr (ReadyForConstructionPL -> Bool)
-> ([ReadyForConstructionPL] -> ReadyForConstructionPL)
-> [ReadyForConstructionPL]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> ReadyForConstructionPL
forall a. [a] -> a
head ([ReadyForConstructionPL] -> Bool)
-> [ReadyForConstructionPL] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss) Bool -> Bool -> Bool
&& (ReadyForConstructionPL -> Bool
isStr (ReadyForConstructionPL -> Bool)
-> ([ReadyForConstructionPL] -> ReadyForConstructionPL)
-> [ReadyForConstructionPL]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> ReadyForConstructionPL
forall a. [a] -> a
head ([ReadyForConstructionPL] -> Bool)
-> [ReadyForConstructionPL] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
zss) = ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL ([ReadyForConstructionPL] -> ReadyForConstructionPL
forall a. [a] -> a
head [ReadyForConstructionPL]
zss) (Heap Int -> [ReadyForConstructionPL])
-> ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap Int -> Heap Int -> Heap Int
forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionPL] -> Heap Int
toHeapR [ReadyForConstructionPL]
zss) (Heap Int -> Heap Int)
-> ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> Heap Int
toHeapR ([ReadyForConstructionPL] -> [ReadyForConstructionPL])
-> [ReadyForConstructionPL] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss
 | (ReadyForConstructionPL -> Bool
isFSL (ReadyForConstructionPL -> Bool)
-> ([ReadyForConstructionPL] -> ReadyForConstructionPL)
-> [ReadyForConstructionPL]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> ReadyForConstructionPL
forall a. [a] -> a
head ([ReadyForConstructionPL] -> Bool)
-> [ReadyForConstructionPL] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss) Bool -> Bool -> Bool
&& (ReadyForConstructionPL -> Bool
isFSL (ReadyForConstructionPL -> Bool)
-> ([ReadyForConstructionPL] -> ReadyForConstructionPL)
-> [ReadyForConstructionPL]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> ReadyForConstructionPL
forall a. [a] -> a
head ([ReadyForConstructionPL] -> Bool)
-> [ReadyForConstructionPL] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
zss) = ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL ([ReadyForConstructionPL] -> ReadyForConstructionPL
forall a. [a] -> a
head [ReadyForConstructionPL]
zss) (Heap Int -> [ReadyForConstructionPL])
-> ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap Int -> Heap Int -> Heap Int
forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionPL] -> Heap Int
toHeapR [ReadyForConstructionPL]
zss) (Heap Int -> Heap Int)
-> ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> Heap Int
toHeapR ([ReadyForConstructionPL] -> [ReadyForConstructionPL])
-> [ReadyForConstructionPL] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss
 | ReadyForConstructionPL -> Bool
isStr (ReadyForConstructionPL -> Bool)
-> ([ReadyForConstructionPL] -> ReadyForConstructionPL)
-> [ReadyForConstructionPL]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> ReadyForConstructionPL
forall a. [a] -> a
head ([ReadyForConstructionPL] -> Bool)
-> [ReadyForConstructionPL] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss = ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL ([ReadyForConstructionPL] -> ReadyForConstructionPL
forall a. [a] -> a
head [ReadyForConstructionPL]
zss) (Heap Int -> [ReadyForConstructionPL])
-> ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap Int -> Heap Int -> Heap Int
forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionPL] -> Heap Int
toHeapR [ReadyForConstructionPL]
zss) (Heap Int -> Heap Int)
-> ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> Heap Int
toHeapR ([ReadyForConstructionPL] -> Heap Int)
-> ([ReadyForConstructionPL] -> [ReadyForConstructionPL])
-> [ReadyForConstructionPL]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL -> ReadyForConstructionPL)
-> [ReadyForConstructionPL] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> ReadyForConstructionPL
FSLG ([[[Int8]]] -> ReadyForConstructionPL)
-> (ReadyForConstructionPL -> [[[Int8]]])
-> ReadyForConstructionPL
-> ReadyForConstructionPL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Int8]]]
convF (String -> [[[Int8]]])
-> (ReadyForConstructionPL -> String)
-> ReadyForConstructionPL
-> [[[Int8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (ReadyForConstructionPL -> Maybe String)
-> ReadyForConstructionPL
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionPL -> Maybe String
fromReadyFCPLS) ([ReadyForConstructionPL] -> [ReadyForConstructionPL])
-> [ReadyForConstructionPL] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
tss
 | Bool
otherwise = ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL]
fromHeapReadyFCPL ([ReadyForConstructionPL] -> ReadyForConstructionPL
forall a. [a] -> a
head [ReadyForConstructionPL]
tss) (Heap Int -> [ReadyForConstructionPL])
-> ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL]
-> [ReadyForConstructionPL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap Int -> Heap Int -> Heap Int
forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionPL] -> Heap Int
toHeapR ([ReadyForConstructionPL] -> Heap Int)
-> ([ReadyForConstructionPL] -> [ReadyForConstructionPL])
-> [ReadyForConstructionPL]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL -> ReadyForConstructionPL)
-> [ReadyForConstructionPL] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> ReadyForConstructionPL
FSLG ([[[Int8]]] -> ReadyForConstructionPL)
-> (ReadyForConstructionPL -> [[[Int8]]])
-> ReadyForConstructionPL
-> ReadyForConstructionPL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Int8]]]
convF (String -> [[[Int8]]])
-> (ReadyForConstructionPL -> String)
-> ReadyForConstructionPL
-> [[[Int8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (ReadyForConstructionPL -> Maybe String)
-> ReadyForConstructionPL
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionPL -> Maybe String
fromReadyFCPLS) ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL] -> Heap Int
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionPL]
zss) (Heap Int -> Heap Int)
-> ([ReadyForConstructionPL] -> Heap Int)
-> [ReadyForConstructionPL]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionPL] -> Heap Int
toHeapR ([ReadyForConstructionPL] -> [ReadyForConstructionPL])
-> [ReadyForConstructionPL] -> [ReadyForConstructionPL]
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 Newline -> Newline -> Bool
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) 
 | [[ReadyForConstructionPL]] -> Bool
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
 | [[ReadyForConstructionPL]] -> Bool
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) = ([ReadyForConstructionPL] -> Bool)
-> [[ReadyForConstructionPL]]
-> ([[ReadyForConstructionPL]], [[ReadyForConstructionPL]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([ReadyForConstructionPL] -> [ReadyForConstructionPL] -> Bool
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 [ReadyForConstructionPL]
-> [[ReadyForConstructionPL]] -> [[ReadyForConstructionPL]]
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]]
_ = []