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

-- |
-- Module      :  Phladiprelio.Ukrainian.DeEnCoding
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@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 Phladiprelio.Ukrainian.DeEnCoding where

import GHC.Base hiding (foldr)
import GHC.Num ((+),(-),(*))
import GHC.Real (quotRem)
import GHC.Enum (fromEnum,toEnum)
import Data.Tuple (fst,snd)
import qualified Data.Heap as Heap
import GHC.Int
import System.IO
import Data.Maybe (fromJust)
import Numeric (showHex,readHex)
import Phladiprelio.Ukrainian.Emphasis
import Phladiprelio.Ukrainian.Melodics (FlowSound)
import Phladiprelio.Ukrainian.Syllable
import Data.Foldable (Foldable, foldr,null,foldl')
import Data.List (sort,head,words,zip,length,unwords,init,partition,sortOn)

--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 b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> b
snd 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.Ukrainian.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 -> FlowSound
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 -> FlowSound
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 :: FlowSound -> ShowS
decodeToStr FlowSound
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 b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip FlowSound
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.
--
decodeToReadyFCUkr :: [Int8] -> ReadyForConstructionUkr -> ReadyForConstructionUkr
decodeToReadyFCUkr :: FlowSound -> ReadyForConstructionUkr -> ReadyForConstructionUkr
decodeToReadyFCUkr FlowSound
ys (Str String
ts) = String -> ReadyForConstructionUkr
Str 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 b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip FlowSound
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
decodeToReadyFCUkr FlowSound
ys (FSL [[FlowSound]]
tsss) = [[FlowSound]] -> ReadyForConstructionUkr
FSL 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 b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip FlowSound
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
$ [[FlowSound]]
tsss
{-# INLINE decodeToReadyFCUkr #-}

-- | Every 'String' consists of words with whitespace symbols in between.
toHeap :: [String] -> Heap.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 :: [ReadyForConstructionUkr] -> Heap.Heap Int
toHeapR :: [ReadyForConstructionUkr] -> Heap Int
toHeapR yss :: [ReadyForConstructionUkr]
yss@(xs :: ReadyForConstructionUkr
xs@(Str String
ts):[ReadyForConstructionUkr]
xss)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionUkr]
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
. ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS) forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
yss
toHeapR yss :: [ReadyForConstructionUkr]
yss@(xs :: ReadyForConstructionUkr
xs@(FSL [[FlowSound]]
tsss):[ReadyForConstructionUkr]
xss)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionUkr]
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
$ [[FlowSound]]
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
. ReadyForConstructionUkr -> Maybe [[FlowSound]]
fromReadyFCUkrF) forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
yss  
toHeapR [ReadyForConstructionUkr]
_ = forall a. Heap a
Heap.empty
{-# INLINE toHeapR #-}

fromHeap :: String -> Heap.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 FlowSound -> ShowS
decodeToStr String
ys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FlowSound
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 #-}

fromHeapReadyFCUkr :: ReadyForConstructionUkr -> Heap.Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr :: ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr ReadyForConstructionUkr
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 FlowSound -> ReadyForConstructionUkr -> ReadyForConstructionUkr
decodeToReadyFCUkr ReadyForConstructionUkr
ys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FlowSound
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 fromHeapReadyFCUkr #-}

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 #-}

intersectInterReadyFCUkr :: (String -> [[FlowSound]]) -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]
intersectInterReadyFCUkr :: (String -> [[FlowSound]])
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
intersectInterReadyFCUkr String -> [[FlowSound]]
convF [ReadyForConstructionUkr]
zss [ReadyForConstructionUkr]
tss
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionUkr]
zss = []
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ReadyForConstructionUkr]
tss = []
 | (ReadyForConstructionUkr -> Bool
isStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss) Bool -> Bool -> Bool
&& (ReadyForConstructionUkr -> Bool
isStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
zss) = ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr (forall a. [a] -> a
head [ReadyForConstructionUkr]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionUkr] -> Heap Int
toHeapR [ReadyForConstructionUkr]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> Heap Int
toHeapR forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss
 | (ReadyForConstructionUkr -> Bool
isFSL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss) Bool -> Bool -> Bool
&& (ReadyForConstructionUkr -> Bool
isFSL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
zss) = ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr (forall a. [a] -> a
head [ReadyForConstructionUkr]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionUkr] -> Heap Int
toHeapR [ReadyForConstructionUkr]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> Heap Int
toHeapR forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss
 | ReadyForConstructionUkr -> Bool
isStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss = ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr (forall a. [a] -> a
head [ReadyForConstructionUkr]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionUkr] -> Heap Int
toHeapR [ReadyForConstructionUkr]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> Heap Int
toHeapR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([[FlowSound]] -> ReadyForConstructionUkr
FSL forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[FlowSound]]
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
. ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS) forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
tss
 | Bool
otherwise = ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]
fromHeapReadyFCUkr (forall a. [a] -> a
head [ReadyForConstructionUkr]
tss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Heap a -> Heap a -> Heap a
Heap.intersect ([ReadyForConstructionUkr] -> Heap Int
toHeapR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([[FlowSound]] -> ReadyForConstructionUkr
FSL forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[FlowSound]]
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
. ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS) forall a b. (a -> b) -> a -> b
$ [ReadyForConstructionUkr]
zss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadyForConstructionUkr] -> Heap Int
toHeapR 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 -> [[FlowSound]])
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
-> [ReadyForConstructionUkr]
intersectInterReadyFCUkr (String -> String -> [[FlowSound]]
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 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) 
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ReadyForConstructionUkr]]
pss = String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]
foldlI' String
ts [[ReadyForConstructionUkr]]
qss
 | 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Ord a => a -> a -> Bool
< [[[FlowSound]] -> 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 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]]
_ = []