-- |
-- Module      :  Phonetic.Languages.Simplified.Lists.DeEnCoding
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Functions to encode and decode 'String' -> \['Int8'\] used in the Simple/Main.hs code.

{-# LANGUAGE BangPatterns #-}

module Phonetic.Languages.Simplified.Lists.DeEnCoding where

import Data.Heap (Heap)
import qualified Data.Heap as Heap
import GHC.Int
import Data.Foldable (foldl')
import Data.List (sortBy,sort)
import System.IO

--default (Int, Double)

encodeToInt :: [String] -> Int
encodeToInt :: [String] -> Int
encodeToInt [String]
yss = (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
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Int
0 ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, String) -> Int) -> [(Int8, String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int8
j,String
_) -> Int8 -> Int
forall a. Enum a => a -> Int
fromEnum Int8
j) ([(Int8, String)] -> [Int])
-> ([String] -> [(Int8, String)]) -> [String] -> [Int]
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 -> String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int8, String) -> String
forall a b. (a, b) -> b
snd (Int8, String)
x) ((Int8, String) -> String
forall a b. (a, b) -> b
snd (Int8, String)
y)) ([(Int8, String)] -> [(Int8, String)])
-> ([String] -> [(Int8, String)]) -> [String] -> [(Int8, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(Int8, String)]
forall a. [[a]] -> [(Int8, [a])]
trans2 ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ [String]
yss
{-# 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
10 = [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
10
           !l :: Int8
l = Int -> Int8
forall a. Enum a => Int -> a
toEnum Int
l0
{-# INLINABLE int2l #-}

-- | So:
-- > decodeToStr (int2l . encodeToInt . words $ xs) xs == unwords . words $ xs
--
decodeToStr :: [Int8] -> String -> String
decodeToStr :: [Int8] -> String -> String
decodeToStr [Int8]
ys = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
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 #-}

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

fromHeap :: String -> Heap Int -> [String]
fromHeap :: String -> Heap Int -> [String]
fromHeap String
ys Heap Int
heap
 | Heap Int -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Heap.null Heap Int
heap = []
 | Bool
otherwise = (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (([Int8] -> String -> String) -> String -> [Int8] -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Int8] -> String -> String
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 #-}

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

-- | 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"