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

-- |
-- Module      :  Phonetic.Languages.Simplified.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.
-- Is taken from the @phonetic-languages-simplified-lists-examples@ package.

module Phonetic.Languages.Simplified.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.Emphasis
import Melodics.Ukrainian.ArrInt8 (FlowSound)
import Languages.Phonetic.Ukrainian.Syllable.ArrInt8

--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.
--
decodeToReadyFCUkr :: [Int8] -> ReadyForConstructionUkr -> ReadyForConstructionUkr
decodeToReadyFCUkr :: [Int8] -> ReadyForConstructionUkr -> ReadyForConstructionUkr
decodeToReadyFCUkr [Int8]
ys (Str String
ts) = String -> ReadyForConstructionUkr
Str (String -> ReadyForConstructionUkr)
-> ShowS -> String -> ReadyForConstructionUkr
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 -> ReadyForConstructionUkr)
-> String -> ReadyForConstructionUkr
forall a b. (a -> b) -> a -> b
$ String
ts
decodeToReadyFCUkr [Int8]
ys (FSL [[[Int8]]]
tsss) = [[[Int8]]] -> ReadyForConstructionUkr
FSL ([[[Int8]]] -> ReadyForConstructionUkr)
-> ([[[Int8]]] -> [[[Int8]]])
-> [[[Int8]]]
-> ReadyForConstructionUkr
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]]] -> ReadyForConstructionUkr)
-> [[[Int8]]] -> ReadyForConstructionUkr
forall a b. (a -> b) -> a -> b
$ [[[Int8]]]
tsss
{-# INLINE decodeToReadyFCUkr #-}

-- | 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 :: [ReadyForConstructionUkr] -> Heap Int
toHeapR :: [ReadyForConstructionUkr] -> Heap Int
toHeapR yss :: [ReadyForConstructionUkr]
yss@(xs :: ReadyForConstructionUkr
xs@(Str String
ts):[ReadyForConstructionUkr]
xss)
  | [ReadyForConstructionUkr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionUkr]
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)
-> ([ReadyForConstructionUkr] -> [Int])
-> [ReadyForConstructionUkr]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionUkr -> Int)
-> [ReadyForConstructionUkr] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Int
forall a. Ord a => [[a]] -> Int
encodeToInt ([String] -> Int)
-> (ReadyForConstructionUkr -> [String])
-> ReadyForConstructionUkr
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String])
-> (ReadyForConstructionUkr -> String)
-> ReadyForConstructionUkr
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (ReadyForConstructionUkr -> Maybe String)
-> ReadyForConstructionUkr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS) ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr] -> Heap Int
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
yss
toHeapR yss :: [ReadyForConstructionUkr]
yss@(xs :: ReadyForConstructionUkr
xs@(FSL [[[Int8]]]
tsss):[ReadyForConstructionUkr]
xss)
  | [ReadyForConstructionUkr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionUkr]
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)
-> ([ReadyForConstructionUkr] -> [Int])
-> [ReadyForConstructionUkr]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionUkr -> Int)
-> [ReadyForConstructionUkr] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> Int
forall a. Ord a => [[a]] -> Int
encodeToInt ([[[Int8]]] -> Int)
-> (ReadyForConstructionUkr -> [[[Int8]]])
-> ReadyForConstructionUkr
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [[[Int8]]] -> [[[Int8]]]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [[[Int8]]] -> [[[Int8]]])
-> (ReadyForConstructionUkr -> Maybe [[[Int8]]])
-> ReadyForConstructionUkr
-> [[[Int8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionUkr -> Maybe [[[Int8]]]
fromReadyFCUkrF) ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr] -> Heap Int
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
yss  
toHeapR [ReadyForConstructionUkr]
_ = 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 #-}

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

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.
intersectInterReadyFCUkr :: (String -> [[FlowSound]]) -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]
intersectInterReadyFCUkr :: (String -> [[[Int8]]])
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
intersectInterReadyFCUkr String -> [[[Int8]]]
convF [ReadyForConstructionUkr]
zss [ReadyForConstructionUkr]
tss
 | [ReadyForConstructionUkr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionUkr]
zss = []
 | [ReadyForConstructionUkr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionUkr]
tss = []
 | (ReadyForConstructionUkr -> Bool
isStr (ReadyForConstructionUkr -> Bool)
-> ([ReadyForConstructionUkr] -> ReadyForConstructionUkr)
-> [ReadyForConstructionUkr]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> ReadyForConstructionUkr
forall a. [a] -> a
head ([ReadyForConstructionUkr] -> Bool)
-> [ReadyForConstructionUkr] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss) Bool -> Bool -> Bool
&& (ReadyForConstructionUkr -> Bool
isStr (ReadyForConstructionUkr -> Bool)
-> ([ReadyForConstructionUkr] -> ReadyForConstructionUkr)
-> [ReadyForConstructionUkr]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> ReadyForConstructionUkr
forall a. [a] -> a
head ([ReadyForConstructionUkr] -> Bool)
-> [ReadyForConstructionUkr] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
zss) = ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr ([ReadyForConstructionUkr] -> ReadyForConstructionUkr
forall a. [a] -> a
head [ReadyForConstructionUkr]
zss) (Heap Int -> [ReadyForConstructionUkr])
-> ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
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 ([ReadyForConstructionUkr] -> Heap Int
toHeapR [ReadyForConstructionUkr]
zss) (Heap Int -> Heap Int)
-> ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> Heap Int
toHeapR ([ReadyForConstructionUkr] -> [ReadyForConstructionUkr])
-> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss
 | (ReadyForConstructionUkr -> Bool
isFSL (ReadyForConstructionUkr -> Bool)
-> ([ReadyForConstructionUkr] -> ReadyForConstructionUkr)
-> [ReadyForConstructionUkr]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> ReadyForConstructionUkr
forall a. [a] -> a
head ([ReadyForConstructionUkr] -> Bool)
-> [ReadyForConstructionUkr] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss) Bool -> Bool -> Bool
&& (ReadyForConstructionUkr -> Bool
isFSL (ReadyForConstructionUkr -> Bool)
-> ([ReadyForConstructionUkr] -> ReadyForConstructionUkr)
-> [ReadyForConstructionUkr]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> ReadyForConstructionUkr
forall a. [a] -> a
head ([ReadyForConstructionUkr] -> Bool)
-> [ReadyForConstructionUkr] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
zss) = ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr ([ReadyForConstructionUkr] -> ReadyForConstructionUkr
forall a. [a] -> a
head [ReadyForConstructionUkr]
zss) (Heap Int -> [ReadyForConstructionUkr])
-> ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
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 ([ReadyForConstructionUkr] -> Heap Int
toHeapR [ReadyForConstructionUkr]
zss) (Heap Int -> Heap Int)
-> ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> Heap Int
toHeapR ([ReadyForConstructionUkr] -> [ReadyForConstructionUkr])
-> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss
 | ReadyForConstructionUkr -> Bool
isStr (ReadyForConstructionUkr -> Bool)
-> ([ReadyForConstructionUkr] -> ReadyForConstructionUkr)
-> [ReadyForConstructionUkr]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> ReadyForConstructionUkr
forall a. [a] -> a
head ([ReadyForConstructionUkr] -> Bool)
-> [ReadyForConstructionUkr] -> Bool
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss = ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr ([ReadyForConstructionUkr] -> ReadyForConstructionUkr
forall a. [a] -> a
head [ReadyForConstructionUkr]
zss) (Heap Int -> [ReadyForConstructionUkr])
-> ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
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 ([ReadyForConstructionUkr] -> Heap Int
toHeapR [ReadyForConstructionUkr]
zss) (Heap Int -> Heap Int)
-> ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> Heap Int
toHeapR ([ReadyForConstructionUkr] -> Heap Int)
-> ([ReadyForConstructionUkr] -> [ReadyForConstructionUkr])
-> [ReadyForConstructionUkr]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionUkr -> ReadyForConstructionUkr)
-> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> ReadyForConstructionUkr
FSL ([[[Int8]]] -> ReadyForConstructionUkr)
-> (ReadyForConstructionUkr -> [[[Int8]]])
-> ReadyForConstructionUkr
-> ReadyForConstructionUkr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Int8]]]
convF (String -> [[[Int8]]])
-> (ReadyForConstructionUkr -> String)
-> ReadyForConstructionUkr
-> [[[Int8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (ReadyForConstructionUkr -> Maybe String)
-> ReadyForConstructionUkr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS) ([ReadyForConstructionUkr] -> [ReadyForConstructionUkr])
-> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss
 | Bool
otherwise = ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr ([ReadyForConstructionUkr] -> ReadyForConstructionUkr
forall a. [a] -> a
head [ReadyForConstructionUkr]
tss) (Heap Int -> [ReadyForConstructionUkr])
-> ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
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 ([ReadyForConstructionUkr] -> Heap Int
toHeapR ([ReadyForConstructionUkr] -> Heap Int)
-> ([ReadyForConstructionUkr] -> [ReadyForConstructionUkr])
-> [ReadyForConstructionUkr]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionUkr -> ReadyForConstructionUkr)
-> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]
forall a b. (a -> b) -> [a] -> [b]
map ([[[Int8]]] -> ReadyForConstructionUkr
FSL ([[[Int8]]] -> ReadyForConstructionUkr)
-> (ReadyForConstructionUkr -> [[[Int8]]])
-> ReadyForConstructionUkr
-> ReadyForConstructionUkr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Int8]]]
convF (String -> [[[Int8]]])
-> (ReadyForConstructionUkr -> String)
-> ReadyForConstructionUkr
-> [[[Int8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (ReadyForConstructionUkr -> Maybe String)
-> ReadyForConstructionUkr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS) ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr] -> Heap Int
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
zss) (Heap Int -> Heap Int)
-> ([ReadyForConstructionUkr] -> Heap Int)
-> [ReadyForConstructionUkr]
-> Heap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> Heap Int
toHeapR ([ReadyForConstructionUkr] -> [ReadyForConstructionUkr])
-> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]
forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss
{-# INLINE intersectInterReadyFCUkr #-}

intersectInterReadyFCUkr2 :: String -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]
intersectInterReadyFCUkr2 :: String
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
intersectInterReadyFCUkr2 String
ts = (String -> [[[Int8]]])
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
intersectInterReadyFCUkr (String -> String -> [[[Int8]]]
convFI String
ts)
{-# INLINE intersectInterReadyFCUkr2 #-}

-- | 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 :: String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI :: String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI String
ts jss :: [[ReadyForConstructionUkr]]
jss@((![ReadyForConstructionUkr]
xs):[ReadyForConstructionUkr]
ys:[[ReadyForConstructionUkr]]
xss) 
 | [[ReadyForConstructionUkr]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ReadyForConstructionUkr]]
pss = String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI' String
ts [[ReadyForConstructionUkr]]
qss
 | [[ReadyForConstructionUkr]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ReadyForConstructionUkr]]
qss = String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI' String
ts [[ReadyForConstructionUkr]]
pss
 | Bool
otherwise = String
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
intersectInterReadyFCUkr2 String
ts (String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI' String
ts [[ReadyForConstructionUkr]]
pss) (String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI' String
ts [[ReadyForConstructionUkr]]
qss) 
  where ([[ReadyForConstructionUkr]]
pss,[[ReadyForConstructionUkr]]
qss) = ([ReadyForConstructionUkr] -> Bool)
-> [[ReadyForConstructionUkr]]
-> ([[ReadyForConstructionUkr]], [[ReadyForConstructionUkr]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([ReadyForConstructionUkr] -> [ReadyForConstructionUkr] -> Bool
forall a. Ord a => a -> a -> Bool
< [[[[Int8]]] -> ReadyForConstructionUkr
FSL []]) [[ReadyForConstructionUkr]]
jss
        foldlI' :: String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI' String
ts rss :: [[ReadyForConstructionUkr]]
rss@([ReadyForConstructionUkr]
rs:[ReadyForConstructionUkr]
ps:[[ReadyForConstructionUkr]]
yss) = String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI' String
ts (String
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
intersectInterReadyFCUkr2 String
ts [ReadyForConstructionUkr]
rs [ReadyForConstructionUkr]
ps [ReadyForConstructionUkr]
-> [[ReadyForConstructionUkr]] -> [[ReadyForConstructionUkr]]
forall a. a -> [a] -> [a]
: [[ReadyForConstructionUkr]]
yss)
        foldlI' String
ts ((![ReadyForConstructionUkr]
xs):[[ReadyForConstructionUkr]]
_) = [ReadyForConstructionUkr]
xs
        foldlI' String
_ [[ReadyForConstructionUkr]]
_ = []
foldlI String
_ ((![ReadyForConstructionUkr]
xs):[[ReadyForConstructionUkr]]
_) = [ReadyForConstructionUkr]
xs
foldlI String
_ [[ReadyForConstructionUkr]]
_ = []