{-# OPTIONS_HADDOCK show-extensions #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}

-- |
-- Module      :  Data.Phonetic.Languages.Base
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- This is a computational scheme for generalized usage of the phonetic languages approach. 
-- It is intended to be exported qualified, so that the functions in every language
-- implementation have the same names and signatures as these ones and the data type used here.
-- It is may be not the most efficient implementation.
-- 

module Data.Phonetic.Languages.Base (
  -- * Phonetics representation data type for the phonetic languages approach.
  PhoneticsRepresentationPL(..)
  , PhoneticsRepresentationPLX(..)
  , Generations
  , InterGenerationsString
  , WritingSystemPRPLX
  , GWritingSystemPRPLX
  , PhoneticRepresentationXInter
  , IGWritingSystemPRPLX
  , fromX2PRPL
  , fromPhoneticRX
  -- * Functions to work with the one.
  -- ** Predicates
  , isPRC
  , isPRAfterC
  , isPRBeforeC
  , isPREmptyC
  -- ** Convert to the 'PhoneticsRepresentationPLX'.
  , stringToXSG
  , stringToXG
  , stringToXS
  , string2X
  -- ** Apply conversion from 'PhoneticsRepresentationPLX'.
  , rulesX
  -- * Auxiliary functions
  , fHelp4
  , findSA
  , findSAI
  -- * Some class extensions for 'Eq' and 'Ord' type classes
  , (~=)
  , compareG
) where

import Data.List (sortBy,groupBy,nub,(\\),find,partition)
import GHC.Int (Int8(..))
import Data.Maybe (isJust,fromJust)
import Data.Either
import GHC.Arr
import GHC.Exts

-- | The intended conversion to the syllables for a written word is: 
-- @
-- toSyllables . map rulesPR . stringToPRPL
-- @
-- The syllable after this is encoded with the representation with every 'Char' being some phonetic language phenomenon.
-- To see its usual written representation, use the defined 'showRepr' function (please, implement your own one).
data PhoneticsRepresentationPL = PR { PhoneticsRepresentationPL -> String
string :: String, PhoneticsRepresentationPL -> String
afterString :: String, PhoneticsRepresentationPL -> String
beforeString :: String } |
  PRAfter { string :: String, afterString :: String } |
  PRBefore { string :: String, beforeString :: String } |
  PREmpty { string :: String }
    deriving (PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
(PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool)
-> (PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool)
-> Eq PhoneticsRepresentationPL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
$c/= :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
== :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
$c== :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
Eq, Eq PhoneticsRepresentationPL
Eq PhoneticsRepresentationPL
-> (PhoneticsRepresentationPL
    -> PhoneticsRepresentationPL -> Ordering)
-> (PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool)
-> (PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool)
-> (PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool)
-> (PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool)
-> (PhoneticsRepresentationPL
    -> PhoneticsRepresentationPL -> PhoneticsRepresentationPL)
-> (PhoneticsRepresentationPL
    -> PhoneticsRepresentationPL -> PhoneticsRepresentationPL)
-> Ord PhoneticsRepresentationPL
PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Ordering
PhoneticsRepresentationPL
-> PhoneticsRepresentationPL -> PhoneticsRepresentationPL
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PhoneticsRepresentationPL
-> PhoneticsRepresentationPL -> PhoneticsRepresentationPL
$cmin :: PhoneticsRepresentationPL
-> PhoneticsRepresentationPL -> PhoneticsRepresentationPL
max :: PhoneticsRepresentationPL
-> PhoneticsRepresentationPL -> PhoneticsRepresentationPL
$cmax :: PhoneticsRepresentationPL
-> PhoneticsRepresentationPL -> PhoneticsRepresentationPL
>= :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
$c>= :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
> :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
$c> :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
<= :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
$c<= :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
< :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
$c< :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Bool
compare :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Ordering
$ccompare :: PhoneticsRepresentationPL -> PhoneticsRepresentationPL -> Ordering
$cp1Ord :: Eq PhoneticsRepresentationPL
Ord)

-- | Extended variant of the 'PhoneticsRepresentationPL' data type where the information for the 'Char' is encoded into the
-- data itself. Is easier to implement the rules in the separate file by just specifying the proper and complete list of
-- 'PhoneticsRepresentationPLX' values. 
data PhoneticsRepresentationPLX = PRC { PhoneticsRepresentationPLX -> String
stringX :: String, PhoneticsRepresentationPLX -> String
afterStringX :: String, PhoneticsRepresentationPLX -> String
beforeStringX :: String, PhoneticsRepresentationPLX -> Char
char :: Char } |
  PRAfterC { stringX :: String, afterStringX :: String, char :: Char } |
  PRBeforeC { stringX :: String, beforeStringX :: String, char :: Char } |
  PREmptyC { stringX :: String, char :: Char }
    deriving (PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
(PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX
    -> PhoneticsRepresentationPLX -> Bool)
-> Eq PhoneticsRepresentationPLX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
$c/= :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
== :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
$c== :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
Eq, Eq PhoneticsRepresentationPLX
Eq PhoneticsRepresentationPLX
-> (PhoneticsRepresentationPLX
    -> PhoneticsRepresentationPLX -> Ordering)
-> (PhoneticsRepresentationPLX
    -> PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX
    -> PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX
    -> PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX
    -> PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX
    -> PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (PhoneticsRepresentationPLX
    -> PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Ord PhoneticsRepresentationPLX
PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
PhoneticsRepresentationPLX
-> PhoneticsRepresentationPLX -> Ordering
PhoneticsRepresentationPLX
-> PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PhoneticsRepresentationPLX
-> PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
$cmin :: PhoneticsRepresentationPLX
-> PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
max :: PhoneticsRepresentationPLX
-> PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
$cmax :: PhoneticsRepresentationPLX
-> PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
>= :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
$c>= :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
> :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
$c> :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
<= :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
$c<= :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
< :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
$c< :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
compare :: PhoneticsRepresentationPLX
-> PhoneticsRepresentationPLX -> Ordering
$ccompare :: PhoneticsRepresentationPLX
-> PhoneticsRepresentationPLX -> Ordering
$cp1Ord :: Eq PhoneticsRepresentationPLX
Ord)

isPRC :: PhoneticsRepresentationPLX -> Bool
isPRC :: PhoneticsRepresentationPLX -> Bool
isPRC (PRC String
_ String
_ String
_ Char
_) = Bool
True
isPRC PhoneticsRepresentationPLX
_ = Bool
False

isPRAfterC :: PhoneticsRepresentationPLX -> Bool
isPRAfterC :: PhoneticsRepresentationPLX -> Bool
isPRAfterC (PRAfterC String
_ String
_ Char
_) = Bool
True
isPRAfterC PhoneticsRepresentationPLX
_ = Bool
False

isPRBeforeC :: PhoneticsRepresentationPLX -> Bool
isPRBeforeC :: PhoneticsRepresentationPLX -> Bool
isPRBeforeC (PRBeforeC String
_ String
_ Char
_) = Bool
True
isPRBeforeC PhoneticsRepresentationPLX
_ = Bool
False

isPREmptyC :: PhoneticsRepresentationPLX -> Bool
isPREmptyC :: PhoneticsRepresentationPLX -> Bool
isPREmptyC (PREmptyC String
_ Char
_) = Bool
True
isPREmptyC PhoneticsRepresentationPLX
_ = Bool
False

fromX2PRPL :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPL
fromX2PRPL :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPL
fromX2PRPL (PREmptyC String
xs Char
_) = String -> PhoneticsRepresentationPL
PREmpty String
xs
fromX2PRPL (PRAfterC String
xs String
ys Char
_) = String -> String -> PhoneticsRepresentationPL
PRAfter String
xs String
ys
fromX2PRPL (PRBeforeC String
xs String
zs Char
_) = String -> String -> PhoneticsRepresentationPL
PRBefore String
xs String
zs
fromX2PRPL (PRC String
xs String
ys String
zs Char
_) = String -> String -> String -> PhoneticsRepresentationPL
PR String
xs String
ys String
zs
{-# INLINE fromX2PRPL #-}

-- | An analogue of the 'rulesPR' function for 'PhoneticsRepresentationPLX'. 
rulesX :: PhoneticsRepresentationPLX -> Char
rulesX :: PhoneticsRepresentationPLX -> Char
rulesX = PhoneticsRepresentationPLX -> Char
char
{-# INLINE rulesX #-}

stringToXS :: WritingSystemPRPLX -> String -> [String]
stringToXS :: WritingSystemPRPLX -> String -> [String]
stringToXS WritingSystemPRPLX
xs String
ys = String
ks String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> Int -> String -> [String]
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
t [a] -> Int -> [a] -> [[a]]
stringToX' [String]
zss Int
l String
ts
  where !zss :: [String]
zss = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> (WritingSystemPRPLX -> [String])
-> WritingSystemPRPLX
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> String)
-> WritingSystemPRPLX -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PhoneticsRepresentationPLX -> String
stringX (WritingSystemPRPLX -> [String]) -> WritingSystemPRPLX -> [String]
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
xs
        !l :: Int
l = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> 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 (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ [String]
zss
        f :: [a] -> Int -> t [a] -> ([a], [a])
f [a]
ys Int
l t [a]
zss = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ((\[Int]
xs -> if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs then Int
1 else [Int] -> Int
forall a. [a] -> a
head [Int]
xs) ([Int] -> Int) -> ([Int] -> [Int]) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
n -> [a] -> t [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
ys) t [a]
zss) ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [Int
l,Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1..Int
1]) [a]
ys
        {-# INLINE f #-}
        (!String
ks,!String
ts) = String -> Int -> [String] -> (String, String)
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
[a] -> Int -> t [a] -> ([a], [a])
f String
ys Int
l [String]
zss
        stringToX' :: t [a] -> Int -> [a] -> [[a]]
stringToX' t [a]
rss Int
m [a]
vs = [a]
bs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: t [a] -> Int -> [a] -> [[a]]
stringToX' t [a]
rss Int
m [a]
us
           where (![a]
bs,![a]
us) = [a] -> Int -> t [a] -> ([a], [a])
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
[a] -> Int -> t [a] -> ([a], [a])
f [a]
vs Int
m t [a]
rss

{-| Uses the simplest variant of the 'GWritingSystemPRPLX' with just two generations where all the 'PREmptyC' elements in the
'WritingSystemPRPLX' are used in the last order. Can be suitable for simple languages (e. g. Esperanto).
-}
string2X :: WritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
string2X :: WritingSystemPRPLX -> String -> WritingSystemPRPLX
string2X WritingSystemPRPLX
xs = GWritingSystemPRPLX -> String -> WritingSystemPRPLX
stringToXG [(WritingSystemPRPLX
zs,Generations
1),(WritingSystemPRPLX
ys,Generations
0)]
  where (WritingSystemPRPLX
ys,WritingSystemPRPLX
zs) = (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> (WritingSystemPRPLX, WritingSystemPRPLX)
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition PhoneticsRepresentationPLX -> Bool
isPREmptyC WritingSystemPRPLX
xs
{-# INLINE string2X #-}

{-| Each generation represents a subset of rules for representation transformation. The 'PhoneticsRepresentationPLX'
are groupped by the generations so that in every group with the same generation number ('Int8' value, typically starting
from 1) the rules represented have no conflicts with each other (this guarantees that they can be applied simultaneously
without the danger of incorrect interference). Usage of 'Generations' is a design decision and is inspired by the
GHC RULES pragma and the GHC compilation multistage process. 
-}
type Generations = Int8

{-| Each value represents temporary intermediate resulting 'String' data to be transformed further into the representation.
-}
type InterGenerationsString = String

{-| If the list here is proper and complete, then it usually represents the whole writing system of the language. For proper usage,
the list must be sorted in the ascending order.
-}
type WritingSystemPRPLX = [PhoneticsRepresentationPLX]

{-| The \'dynamic\' representation of the general writing system that specifies what transformations are made simultaneously
during the conversion to the phonetic languages phonetics representation. During transformations those elements that have
greater 'Generations' are used earlier than others. The last ones are used those elements with the 'Generations' element
equal to 0 that must correspond to the 'PREmptyC' constructor-built records. For proper usage, the lists on the first
place of the tuples must be sorted in the ascending order.
-}
type GWritingSystemPRPLX = [([PhoneticsRepresentationPLX],Generations)]

type PhoneticRepresentationXInter = Either PhoneticsRepresentationPLX InterGenerationsString

fromPhoneticRX :: [PhoneticsRepresentationPLX] -> [PhoneticRepresentationXInter] -> [PhoneticsRepresentationPLX]
fromPhoneticRX :: WritingSystemPRPLX
-> [PhoneticRepresentationXInter] -> WritingSystemPRPLX
fromPhoneticRX WritingSystemPRPLX
ts = (PhoneticRepresentationXInter -> WritingSystemPRPLX)
-> [PhoneticRepresentationXInter] -> WritingSystemPRPLX
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (WritingSystemPRPLX
-> PhoneticRepresentationXInter -> WritingSystemPRPLX
fromInter2X WritingSystemPRPLX
ts)
  where fromInter2X :: [PhoneticsRepresentationPLX] -> PhoneticRepresentationXInter -> [PhoneticsRepresentationPLX]
        fromInter2X :: WritingSystemPRPLX
-> PhoneticRepresentationXInter -> WritingSystemPRPLX
fromInter2X WritingSystemPRPLX
_ (Left PhoneticsRepresentationPLX
x) = [PhoneticsRepresentationPLX
x]
        fromInter2X WritingSystemPRPLX
ys (Right String
z) = (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
z) (String -> Bool)
-> (PhoneticsRepresentationPLX -> String)
-> PhoneticsRepresentationPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX -> String
stringX) WritingSystemPRPLX
ys

{-| The \'dynamic\' representation of the process of transformation for the general writing system during the conversion.
Is not intended to be produced by hand, but automatically by programs.
-}
type IGWritingSystemPRPLX = [(PhoneticRepresentationXInter,Generations)]

fHelp4 :: (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> [a] -> ([a],[a],[a],[a])
fHelp4 :: (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> [a]
-> ([a], [a], [a], [a])
fHelp4 a -> Bool
p1 a -> Bool
p2 a -> Bool
p3 a -> Bool
p4 = (a -> ([a], [a], [a], [a]) -> ([a], [a], [a], [a]))
-> ([a], [a], [a], [a]) -> [a] -> ([a], [a], [a], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ([a], [a], [a], [a]) -> ([a], [a], [a], [a])
g ([a], [a], [a], [a])
forall a a a a. ([a], [a], [a], [a])
v
  where v :: ([a], [a], [a], [a])
v = ([],[],[],[])
        g :: a -> ([a], [a], [a], [a]) -> ([a], [a], [a], [a])
g a
x ([a]
xs1,[a]
xs2,[a]
xs3,[a]
xs4)
          | a -> Bool
p1 a
x = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs1,[a]
xs2,[a]
xs3,[a]
xs4)
          | a -> Bool
p2 a
x = ([a]
xs1,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs2,[a]
xs3,[a]
xs4)
          | a -> Bool
p3 a
x = ([a]
xs1,[a]
xs2,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs3,[a]
xs4)
          | a -> Bool
p4 a
x = ([a]
xs1,[a]
xs2,[a]
xs3,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs4)
          | Bool
otherwise = ([a]
xs1,[a]
xs2,[a]
xs3,[a]
xs4)
{-# INLINE fHelp4 #-}

-- | Partial equivalence that is used to find the appropriate 'PhoneticsRepresentationPL' for the class of
-- 'PhoneticRepresentationPLX' values. 
(~=) :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Bool
(PR String
xs String
ys String
zs) ~= :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Bool
~= (PRC String
xs1 String
ys1 String
zs1 Char
_) = String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs1 Bool -> Bool -> Bool
&& String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ys1 Bool -> Bool -> Bool
&& String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
zs1
(PRAfter String
xs String
ys) ~= (PRAfterC String
xs1 String
ys1 Char
_) = String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs1 Bool -> Bool -> Bool
&& String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ys1
(PRBefore String
ys String
zs) ~= (PRBeforeC String
ys1 String
zs1 Char
_) = String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ys1 Bool -> Bool -> Bool
&& String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
zs1
(PREmpty String
xs) ~= (PREmptyC String
xs1 Char
_) = String
xs1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs1
PhoneticsRepresentationPL
_ ~= PhoneticsRepresentationPLX
_ = Bool
False

-- | Partial equivalence that is used to find the appropriate 'PhoneticsRepresentationPL' for the class of
-- 'PhoneticRepresentationPLX' values. 
compareG :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Ordering
compareG :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Ordering
compareG (PR String
xs String
ys String
zs) (PRC String
xs1 String
ys1 String
zs1 Char
_)
 | String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
xs1 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
xs String
xs1
 | String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
ys1 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
ys String
ys1
 | String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
zs1 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
zs String
zs1
 | Bool
otherwise = Ordering
EQ
compareG (PR String
_ String
_ String
_) PhoneticsRepresentationPLX
_ = Ordering
LT
compareG (PREmpty String
xs) (PREmptyC String
xs1 Char
_)
 | String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
xs1 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
xs String
xs1
 | Bool
otherwise = Ordering
EQ
compareG (PREmpty String
_) PhoneticsRepresentationPLX
_ = Ordering
GT
compareG (PRAfter String
xs String
ys) (PRAfterC String
xs1 String
ys1 Char
_)
 | String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
xs1 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
xs String
xs1
 | String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
ys1 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
ys String
ys1
 | Bool
otherwise = Ordering
EQ
compareG (PRAfter String
_ String
_) (PRC String
_ String
_ String
_ Char
_) = Ordering
GT
compareG (PRAfter String
_ String
_) PhoneticsRepresentationPLX
_ = Ordering
LT
compareG (PRBefore String
ys String
zs) (PRBeforeC String
ys1 String
zs1 Char
_)
 | String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
ys1 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
ys String
ys1
 | String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
zs1 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
zs String
zs1
 | Bool
otherwise = Ordering
EQ
compareG (PRBefore String
_ String
_) (PREmptyC String
_ Char
_) = Ordering
LT
compareG (PRBefore String
_ String
_) PhoneticsRepresentationPLX
_ = Ordering
GT

-- | Is somewhat rewritten from the 'CaseBi.Arr.gBF3' function (not exported) from the @mmsyn2-array@ package.
gBF3
  :: (# Int#, PhoneticsRepresentationPLX #)
  -> (# Int#, PhoneticsRepresentationPLX #)
  -> PhoneticsRepresentationPL
  -> Array i PhoneticsRepresentationPLX
  -> Maybe PhoneticsRepresentationPLX
gBF3 :: (# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array i PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
gBF3 (# !Int#
i#, PhoneticsRepresentationPLX
k #) (# !Int#
j#, PhoneticsRepresentationPLX
m #) PhoneticsRepresentationPL
repr Array i PhoneticsRepresentationPLX
arr
 | Int# -> Bool
isTrue# ((Int#
j# Int# -> Int# -> Int#
-# Int#
i#) Int# -> Int# -> Int#
># Int#
1# ) = 
    case PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Ordering
compareG PhoneticsRepresentationPL
repr PhoneticsRepresentationPLX
p of
     Ordering
GT -> (# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array i PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
forall i.
(# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array i PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
gBF3 (# Int#
n#, PhoneticsRepresentationPLX
p #) (# Int#
j#, PhoneticsRepresentationPLX
m #) PhoneticsRepresentationPL
repr Array i PhoneticsRepresentationPLX
arr
     Ordering
LT  -> (# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array i PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
forall i.
(# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array i PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
gBF3 (# Int#
i#, PhoneticsRepresentationPLX
k #) (# Int#
n#, PhoneticsRepresentationPLX
p #) PhoneticsRepresentationPL
repr Array i PhoneticsRepresentationPLX
arr
     Ordering
_ -> PhoneticsRepresentationPLX -> Maybe PhoneticsRepresentationPLX
forall a. a -> Maybe a
Just PhoneticsRepresentationPLX
p
 | PhoneticsRepresentationPL
repr PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Bool
~= PhoneticsRepresentationPLX
m = PhoneticsRepresentationPLX -> Maybe PhoneticsRepresentationPLX
forall a. a -> Maybe a
Just PhoneticsRepresentationPLX
m
 | PhoneticsRepresentationPL
repr PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Bool
~= PhoneticsRepresentationPLX
k = PhoneticsRepresentationPLX -> Maybe PhoneticsRepresentationPLX
forall a. a -> Maybe a
Just PhoneticsRepresentationPLX
k
 | Bool
otherwise = Maybe PhoneticsRepresentationPLX
forall a. Maybe a
Nothing
     where !n# :: Int#
n# = (Int#
i# Int# -> Int# -> Int#
+# Int#
j#) Int# -> Int# -> Int#
`quotInt#` Int#
2#
           !p :: PhoneticsRepresentationPLX
p = Array i PhoneticsRepresentationPLX
-> Int -> PhoneticsRepresentationPLX
forall i e. Array i e -> Int -> e
unsafeAt Array i PhoneticsRepresentationPLX
arr (Int# -> Int
I# Int#
n#)
{-# INLINABLE gBF3 #-}

findSA
  :: PhoneticsRepresentationPL
  -> Array Int PhoneticsRepresentationPLX
  -> Maybe PhoneticsRepresentationPLX
findSA :: PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSA PhoneticsRepresentationPL
repr Array Int PhoneticsRepresentationPLX
arr = (# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
forall i.
(# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array i PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
gBF3 (# Int#
i#, PhoneticsRepresentationPLX
k #) (# Int#
j#, PhoneticsRepresentationPLX
m #) PhoneticsRepresentationPL
repr Array Int PhoneticsRepresentationPLX
arr 
     where (!(I# Int#
i#),!(I# Int#
j#)) = Array Int PhoneticsRepresentationPLX -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int PhoneticsRepresentationPLX
arr
           !k :: PhoneticsRepresentationPLX
k = Array Int PhoneticsRepresentationPLX
-> Int -> PhoneticsRepresentationPLX
forall i e. Array i e -> Int -> e
unsafeAt Array Int PhoneticsRepresentationPLX
arr (Int# -> Int
I# Int#
i#)
           !m :: PhoneticsRepresentationPLX
m = Array Int PhoneticsRepresentationPLX
-> Int -> PhoneticsRepresentationPLX
forall i e. Array i e -> Int -> e
unsafeAt Array Int PhoneticsRepresentationPLX
arr (Int# -> Int
I# Int#
i#)

findSAI
  :: PhoneticRepresentationXInter
  -> (String, String)
  -> Array Int PhoneticsRepresentationPLX
  -> Maybe PhoneticsRepresentationPLX
findSAI :: PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI PhoneticRepresentationXInter
repr (String
xs,String
ys) Array Int PhoneticsRepresentationPLX
arr
 | PhoneticRepresentationXInter -> Bool
forall a b. Either a b -> Bool
isLeft PhoneticRepresentationXInter
repr = (# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
forall i.
(# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array i PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
gBF3 (# Int#
i#, PhoneticsRepresentationPLX
k #) (# Int#
j#, PhoneticsRepresentationPLX
m #) (PhoneticsRepresentationPLX -> PhoneticsRepresentationPL
fromX2PRPL (PhoneticsRepresentationPLX -> PhoneticsRepresentationPL)
-> (PhoneticRepresentationXInter -> PhoneticsRepresentationPLX)
-> PhoneticRepresentationXInter
-> PhoneticsRepresentationPL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter -> PhoneticsRepresentationPLX
forall a b. a -> Either a b -> a
fromLeft (String -> Char -> PhoneticsRepresentationPLX
PREmptyC String
" " Char
' ') (PhoneticRepresentationXInter -> PhoneticsRepresentationPL)
-> PhoneticRepresentationXInter -> PhoneticsRepresentationPL
forall a b. (a -> b) -> a -> b
$ PhoneticRepresentationXInter
repr) Array Int PhoneticsRepresentationPLX
arr
 | Bool
otherwise = (# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
forall i.
(# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array i PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
gBF3 (# Int#
i#, PhoneticsRepresentationPLX
k #) (# Int#
j#, PhoneticsRepresentationPLX
m #) (String -> (String, String) -> PhoneticsRepresentationPL
str2PRPL (String -> PhoneticRepresentationXInter -> String
forall b a. b -> Either a b -> b
fromRight [] PhoneticRepresentationXInter
repr) (String
xs,String
ys)) Array Int PhoneticsRepresentationPLX
arr
     where (!(I# Int#
i#),!(I# Int#
j#)) = Array Int PhoneticsRepresentationPLX -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int PhoneticsRepresentationPLX
arr
           !k :: PhoneticsRepresentationPLX
k = Array Int PhoneticsRepresentationPLX
-> Int -> PhoneticsRepresentationPLX
forall i e. Array i e -> Int -> e
unsafeAt Array Int PhoneticsRepresentationPLX
arr (Int# -> Int
I# Int#
i#)
           !m :: PhoneticsRepresentationPLX
m = Array Int PhoneticsRepresentationPLX
-> Int -> PhoneticsRepresentationPLX
forall i e. Array i e -> Int -> e
unsafeAt Array Int PhoneticsRepresentationPLX
arr (Int# -> Int
I# Int#
i#)
           str2PRPL :: String -> (String,String) -> PhoneticsRepresentationPL
           str2PRPL :: String -> (String, String) -> PhoneticsRepresentationPL
str2PRPL String
ts ([],[]) = String -> PhoneticsRepresentationPL
PREmpty String
ts
           str2PRPL String
ts (String
ys,[]) = String -> String -> PhoneticsRepresentationPL
PRBefore String
ts String
ys
           str2PRPL String
ts ([],String
zs) = String -> String -> PhoneticsRepresentationPL
PRAfter String
ts String
zs
           str2PRPL String
ts (String
ys,String
zs) = String -> String -> String -> PhoneticsRepresentationPL
PR String
ts String
zs String
ys

stringToXSG :: GWritingSystemPRPLX -> Generations -> String -> IGWritingSystemPRPLX
stringToXSG :: GWritingSystemPRPLX
-> Generations -> String -> IGWritingSystemPRPLX
stringToXSG GWritingSystemPRPLX
xs Generations
n String
ys
 | ((WritingSystemPRPLX, Generations) -> Bool)
-> GWritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Generations -> Generations -> Bool
forall a. Eq a => a -> a -> Bool
== Generations
n) (Generations -> Bool)
-> ((WritingSystemPRPLX, Generations) -> Generations)
-> (WritingSystemPRPLX, Generations)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WritingSystemPRPLX, Generations) -> Generations
forall a b. (a, b) -> b
snd) GWritingSystemPRPLX
xs Bool -> Bool -> Bool
&& Generations
n Generations -> Generations -> Bool
forall a. Ord a => a -> a -> Bool
> Generations
0 = GWritingSystemPRPLX
-> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
stringToXSGI (GWritingSystemPRPLX
xs GWritingSystemPRPLX -> GWritingSystemPRPLX -> GWritingSystemPRPLX
forall a. Eq a => [a] -> [a] -> [a]
\\ GWritingSystemPRPLX
ts) (Generations
n Generations -> Generations -> Generations
forall a. Num a => a -> a -> a
- Generations
1) (IGWritingSystemPRPLX -> IGWritingSystemPRPLX)
-> ([String] -> IGWritingSystemPRPLX)
-> [String]
-> IGWritingSystemPRPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WritingSystemPRPLX
-> Generations -> [String] -> IGWritingSystemPRPLX
forall a.
Num a =>
WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
zs Generations
n ([String] -> IGWritingSystemPRPLX)
-> [String] -> IGWritingSystemPRPLX
forall a b. (a -> b) -> a -> b
$ [String]
pss
 | Bool
otherwise = String -> IGWritingSystemPRPLX
forall a. HasCallStack => String -> a
error String
"Data.Phonetic.Languages.Base.stringToXSG: Not defined for these first two arguments. "
    where !pss :: [String]
pss = WritingSystemPRPLX -> String -> [String]
stringToXS (((WritingSystemPRPLX, Generations) -> WritingSystemPRPLX)
-> GWritingSystemPRPLX -> WritingSystemPRPLX
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (WritingSystemPRPLX, Generations) -> WritingSystemPRPLX
forall a b. (a, b) -> a
fst GWritingSystemPRPLX
xs) String
ys -- ps :: [String]
          !ts :: GWritingSystemPRPLX
ts = ((WritingSystemPRPLX, Generations) -> Bool)
-> GWritingSystemPRPLX -> GWritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter ((Generations -> Generations -> Bool
forall a. Eq a => a -> a -> Bool
== Generations
n) (Generations -> Bool)
-> ((WritingSystemPRPLX, Generations) -> Generations)
-> (WritingSystemPRPLX, Generations)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WritingSystemPRPLX, Generations) -> Generations
forall a b. (a, b) -> b
snd) (GWritingSystemPRPLX -> GWritingSystemPRPLX)
-> GWritingSystemPRPLX -> GWritingSystemPRPLX
forall a b. (a -> b) -> a -> b
$ GWritingSystemPRPLX
xs -- ts :: GWritingSystemPRPLX
          !zs :: WritingSystemPRPLX
zs = if GWritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null GWritingSystemPRPLX
ts then [] else (WritingSystemPRPLX, Generations) -> WritingSystemPRPLX
forall a b. (a, b) -> a
fst ((WritingSystemPRPLX, Generations) -> WritingSystemPRPLX)
-> (GWritingSystemPRPLX -> (WritingSystemPRPLX, Generations))
-> GWritingSystemPRPLX
-> WritingSystemPRPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> (WritingSystemPRPLX, Generations)
forall a. [a] -> a
head (GWritingSystemPRPLX -> WritingSystemPRPLX)
-> GWritingSystemPRPLX -> WritingSystemPRPLX
forall a b. (a -> b) -> a -> b
$ GWritingSystemPRPLX
ts -- zs :: PhoneticRepresentationX
          xsG1 :: t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n (String
k1s:String
k2s:String
k3s:[String]
kss) (!Array Int PhoneticsRepresentationPLX
r2s,!Array Int PhoneticsRepresentationPLX
r3s,!Array Int PhoneticsRepresentationPLX
r4s,!Array Int PhoneticsRepresentationPLX
r5s) -- xsG1 :: [PhoneticRepresentationPLX] -> [String] -> Generations -> IGWritingSystemPRPLX
            | Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x1 = (String -> PhoneticRepresentationXInter
forall a b. b -> Either a b
Right String
k1s,a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x1,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n (String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x2 = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x2,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x3 = (String -> PhoneticRepresentationXInter
forall a b. b -> Either a b
Right String
k1s,a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x3,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n (String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Bool
otherwise = (String -> PhoneticRepresentationXInter
forall a b. b -> Either a b
Right String
k1s,a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
                where !x1 :: Maybe PhoneticsRepresentationPLX
x1 = PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSA (String -> String -> String -> PhoneticsRepresentationPL
PR String
k2s String
k3s String
k1s) Array Int PhoneticsRepresentationPLX
r2s
                      !x2 :: Maybe PhoneticsRepresentationPLX
x2 = PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSA (String -> String -> PhoneticsRepresentationPL
PRAfter String
k1s String
k2s) Array Int PhoneticsRepresentationPLX
r3s
                      !x3 :: Maybe PhoneticsRepresentationPLX
x3 = PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSA (String -> String -> PhoneticsRepresentationPL
PRBefore String
k2s String
k1s) Array Int PhoneticsRepresentationPLX
r4s
                      !x4 :: Maybe PhoneticsRepresentationPLX
x4 = PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSA (String -> PhoneticsRepresentationPL
PREmpty String
k1s) Array Int PhoneticsRepresentationPLX
r5s
          xsG1 t
rs a
n (String
k1s:String
k2s:[String]
kss) (!Array Int PhoneticsRepresentationPLX
r2s,!Array Int PhoneticsRepresentationPLX
r3s,!Array Int PhoneticsRepresentationPLX
r4s,!Array Int PhoneticsRepresentationPLX
r5s)
            | Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x2 = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x2,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x3 = (String -> PhoneticRepresentationXInter
forall a b. b -> Either a b
Right String
k1s,a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x3,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n [String]
kss (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Bool
otherwise = (String -> PhoneticRepresentationXInter
forall a b. b -> Either a b
Right String
k1s,a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 t
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
                where !x2 :: Maybe PhoneticsRepresentationPLX
x2 = PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSA (String -> String -> PhoneticsRepresentationPL
PRAfter String
k1s String
k2s) Array Int PhoneticsRepresentationPLX
r3s
                      !x3 :: Maybe PhoneticsRepresentationPLX
x3 = PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSA (String -> String -> PhoneticsRepresentationPL
PRBefore String
k2s String
k1s) Array Int PhoneticsRepresentationPLX
r4s
                      !x4 :: Maybe PhoneticsRepresentationPLX
x4 = PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSA (String -> PhoneticsRepresentationPL
PREmpty String
k1s) Array Int PhoneticsRepresentationPLX
r5s
          xsG1 t
rs a
n [String
k1s] (Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
r5s)
            | Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = [(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,a
n)]
            | Bool
otherwise = [(String -> PhoneticRepresentationXInter
forall a b. b -> Either a b
Right String
k1s,a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)]
                where !x4 :: Maybe PhoneticsRepresentationPLX
x4 = PhoneticsRepresentationPL
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSA (String -> PhoneticsRepresentationPL
PREmpty String
k1s) Array Int PhoneticsRepresentationPLX
r5s
          xsG1 t
rs a
n [] (Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_) = []
          xsG :: WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n [String]
jss = WritingSystemPRPLX
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
forall a t.
Num a =>
t
-> a
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, a)]
xsG1 WritingSystemPRPLX
rs a
n [String]
jss (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            where (!WritingSystemPRPLX
r2ls,!WritingSystemPRPLX
r3ls,!WritingSystemPRPLX
r4ls,!WritingSystemPRPLX
r5ls) = (PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX
-> (WritingSystemPRPLX, WritingSystemPRPLX, WritingSystemPRPLX,
    WritingSystemPRPLX)
forall a.
(a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> [a]
-> ([a], [a], [a], [a])
fHelp4 PhoneticsRepresentationPLX -> Bool
isPRC PhoneticsRepresentationPLX -> Bool
isPRAfterC PhoneticsRepresentationPLX -> Bool
isPRBeforeC PhoneticsRepresentationPLX -> Bool
isPREmptyC WritingSystemPRPLX
rs
                  !r2s :: Array Int PhoneticsRepresentationPLX
r2s = (Int, Int)
-> WritingSystemPRPLX -> Array Int PhoneticsRepresentationPLX
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,WritingSystemPRPLX -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WritingSystemPRPLX
r2ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) WritingSystemPRPLX
r2ls
                  !r3s :: Array Int PhoneticsRepresentationPLX
r3s = (Int, Int)
-> WritingSystemPRPLX -> Array Int PhoneticsRepresentationPLX
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,WritingSystemPRPLX -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WritingSystemPRPLX
r3ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) WritingSystemPRPLX
r3ls
                  !r4s :: Array Int PhoneticsRepresentationPLX
r4s = (Int, Int)
-> WritingSystemPRPLX -> Array Int PhoneticsRepresentationPLX
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,WritingSystemPRPLX -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WritingSystemPRPLX
r4ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) WritingSystemPRPLX
r4ls
                  !r5s :: Array Int PhoneticsRepresentationPLX
r5s = (Int, Int)
-> WritingSystemPRPLX -> Array Int PhoneticsRepresentationPLX
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,WritingSystemPRPLX -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WritingSystemPRPLX
r5ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) WritingSystemPRPLX
r5ls

{-|
Is used internally in the 'stringToXSG' and 'stringToXG' functions respectively. 
-}
stringToXSGI :: GWritingSystemPRPLX -> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
stringToXSGI :: GWritingSystemPRPLX
-> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
stringToXSGI GWritingSystemPRPLX
xs Generations
n IGWritingSystemPRPLX
ys
 | Generations
n Generations -> Generations -> Bool
forall a. Ord a => a -> a -> Bool
> Generations
0 = GWritingSystemPRPLX
-> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
stringToXSGI (GWritingSystemPRPLX
xs GWritingSystemPRPLX -> GWritingSystemPRPLX -> GWritingSystemPRPLX
forall a. Eq a => [a] -> [a] -> [a]
\\ GWritingSystemPRPLX
ts) (Generations
n Generations -> Generations -> Generations
forall a. Num a => a -> a -> a
- Generations
1) (IGWritingSystemPRPLX -> IGWritingSystemPRPLX)
-> (IGWritingSystemPRPLX -> IGWritingSystemPRPLX)
-> IGWritingSystemPRPLX
-> IGWritingSystemPRPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WritingSystemPRPLX
-> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
forall b.
(Eq b, Num b) =>
WritingSystemPRPLX
-> b
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
xsGI WritingSystemPRPLX
zs Generations
n (IGWritingSystemPRPLX -> IGWritingSystemPRPLX)
-> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
forall a b. (a -> b) -> a -> b
$ IGWritingSystemPRPLX
ys
 | Bool
otherwise = IGWritingSystemPRPLX
ys
     where !ts :: GWritingSystemPRPLX
ts = ((WritingSystemPRPLX, Generations) -> Bool)
-> GWritingSystemPRPLX -> GWritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter ((Generations -> Generations -> Bool
forall a. Eq a => a -> a -> Bool
== Generations
n) (Generations -> Bool)
-> ((WritingSystemPRPLX, Generations) -> Generations)
-> (WritingSystemPRPLX, Generations)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WritingSystemPRPLX, Generations) -> Generations
forall a b. (a, b) -> b
snd) GWritingSystemPRPLX
xs -- ts :: GWritingSystemPRPLX
           !zs :: WritingSystemPRPLX
zs = ((WritingSystemPRPLX, Generations) -> WritingSystemPRPLX)
-> GWritingSystemPRPLX -> WritingSystemPRPLX
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (WritingSystemPRPLX, Generations) -> WritingSystemPRPLX
forall a b. (a, b) -> a
fst GWritingSystemPRPLX
ts -- zs :: PhoneticRepresentationX
           xsGI1 :: t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k1s:(PhoneticRepresentationXInter, b)
k2s:(PhoneticRepresentationXInter, b)
k3s:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s) -- xsGI1 :: [PhoneticRepresentationPLX] -> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
            | (PhoneticRepresentationXInter, b) -> b
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k2s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x1 = ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x1,b
n) (PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
: t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k3s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | (PhoneticRepresentationXInter, b) -> b
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x2 = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x2,b
n)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k2s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:(PhoneticRepresentationXInter, b)
k3s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | (PhoneticRepresentationXInter, b) -> b
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k2s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x3 = ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x3 ,b
n)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k3s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | (PhoneticRepresentationXInter, b) -> b
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4, b
n)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k2s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:(PhoneticRepresentationXInter, b)
k3s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Bool
otherwise = ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k2s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:(PhoneticRepresentationXInter, b)
k3s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
                where !x1 :: Maybe PhoneticsRepresentationPLX
x1 = PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k2s) ((PhoneticsRepresentationPLX -> String)
-> (String -> String) -> PhoneticRepresentationXInter -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX String -> String
forall a. a -> a
id (PhoneticRepresentationXInter -> String)
-> ((PhoneticRepresentationXInter, b)
    -> PhoneticRepresentationXInter)
-> (PhoneticRepresentationXInter, b)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst ((PhoneticRepresentationXInter, b) -> String)
-> (PhoneticRepresentationXInter, b) -> String
forall a b. (a -> b) -> a -> b
$ (PhoneticRepresentationXInter, b)
k1s,(PhoneticsRepresentationPLX -> String)
-> (String -> String) -> PhoneticRepresentationXInter -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX String -> String
forall a. a -> a
id (PhoneticRepresentationXInter -> String)
-> ((PhoneticRepresentationXInter, b)
    -> PhoneticRepresentationXInter)
-> (PhoneticRepresentationXInter, b)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst ((PhoneticRepresentationXInter, b) -> String)
-> (PhoneticRepresentationXInter, b) -> String
forall a b. (a -> b) -> a -> b
$ (PhoneticRepresentationXInter, b)
k3s) Array Int PhoneticsRepresentationPLX
r2s
                      !x2 :: Maybe PhoneticsRepresentationPLX
x2 = PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s) ([],(PhoneticsRepresentationPLX -> String)
-> (String -> String) -> PhoneticRepresentationXInter -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX String -> String
forall a. a -> a
id (PhoneticRepresentationXInter -> String)
-> ((PhoneticRepresentationXInter, b)
    -> PhoneticRepresentationXInter)
-> (PhoneticRepresentationXInter, b)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst ((PhoneticRepresentationXInter, b) -> String)
-> (PhoneticRepresentationXInter, b) -> String
forall a b. (a -> b) -> a -> b
$ (PhoneticRepresentationXInter, b)
k2s) Array Int PhoneticsRepresentationPLX
r3s
                      !x3 :: Maybe PhoneticsRepresentationPLX
x3 = PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k2s) ((PhoneticsRepresentationPLX -> String)
-> (String -> String) -> PhoneticRepresentationXInter -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX String -> String
forall a. a -> a
id (PhoneticRepresentationXInter -> String)
-> ((PhoneticRepresentationXInter, b)
    -> PhoneticRepresentationXInter)
-> (PhoneticRepresentationXInter, b)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst ((PhoneticRepresentationXInter, b) -> String)
-> (PhoneticRepresentationXInter, b) -> String
forall a b. (a -> b) -> a -> b
$ (PhoneticRepresentationXInter, b)
k1s,[]) Array Int PhoneticsRepresentationPLX
r4s
                      !x4 :: Maybe PhoneticsRepresentationPLX
x4 = PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s) ([],[]) Array Int PhoneticsRepresentationPLX
r5s
           xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k1s:(PhoneticRepresentationXInter, b)
k2s:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | (PhoneticRepresentationXInter, b) -> b
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x2 = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x2,b
n)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k2s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | (PhoneticRepresentationXInter, b) -> b
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k2s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x3 = ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x3,b
n)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n [(PhoneticRepresentationXInter, b)]
kss (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | (PhoneticRepresentationXInter, b) -> b
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,b
n)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k2s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Bool
otherwise = ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1)(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 t
rs b
n ((PhoneticRepresentationXInter, b)
k2s(PhoneticRepresentationXInter, b)
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
                where !x2 :: Maybe PhoneticsRepresentationPLX
x2 = PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s) ([],(PhoneticsRepresentationPLX -> String)
-> (String -> String) -> PhoneticRepresentationXInter -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX String -> String
forall a. a -> a
id (PhoneticRepresentationXInter -> String)
-> ((PhoneticRepresentationXInter, b)
    -> PhoneticRepresentationXInter)
-> (PhoneticRepresentationXInter, b)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst ((PhoneticRepresentationXInter, b) -> String)
-> (PhoneticRepresentationXInter, b) -> String
forall a b. (a -> b) -> a -> b
$ (PhoneticRepresentationXInter, b)
k2s) Array Int PhoneticsRepresentationPLX
r3s
                      !x3 :: Maybe PhoneticsRepresentationPLX
x3 = PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k2s) ((PhoneticsRepresentationPLX -> String)
-> (String -> String) -> PhoneticRepresentationXInter -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX String -> String
forall a. a -> a
id (PhoneticRepresentationXInter -> String)
-> ((PhoneticRepresentationXInter, b)
    -> PhoneticRepresentationXInter)
-> (PhoneticRepresentationXInter, b)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst ((PhoneticRepresentationXInter, b) -> String)
-> (PhoneticRepresentationXInter, b) -> String
forall a b. (a -> b) -> a -> b
$ (PhoneticRepresentationXInter, b)
k1s,[]) Array Int PhoneticsRepresentationPLX
r4s
                      !x4 :: Maybe PhoneticsRepresentationPLX
x4 = PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s) ([],[]) Array Int PhoneticsRepresentationPLX
r5s
           xsGI1 t
rs b
n [(PhoneticRepresentationXInter, b)
k1s] (Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
r5s)
            | (PhoneticRepresentationXInter, b) -> b
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& Maybe PhoneticsRepresentationPLX -> Bool
forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = [(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> Maybe PhoneticsRepresentationPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> Maybe PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,b
n)]
            | Bool
otherwise = [((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1)]
                where !x4 :: Maybe PhoneticsRepresentationPLX
x4 = PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI ((PhoneticRepresentationXInter, b) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s) ([],[]) Array Int PhoneticsRepresentationPLX
r5s
           xsGI1 t
rs b
n [] (Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_) = []
           xsGI :: WritingSystemPRPLX
-> b
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
xsGI WritingSystemPRPLX
rs b
n [(PhoneticRepresentationXInter, b)]
jss = WritingSystemPRPLX
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
forall b t.
(Eq b, Num b) =>
t
-> b
-> [(PhoneticRepresentationXInter, b)]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, b)]
xsGI1 WritingSystemPRPLX
rs b
n [(PhoneticRepresentationXInter, b)]
jss (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
             where (!WritingSystemPRPLX
r2ls,!WritingSystemPRPLX
r3ls,!WritingSystemPRPLX
r4ls,!WritingSystemPRPLX
r5ls) = (PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX -> Bool)
-> (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX
-> (WritingSystemPRPLX, WritingSystemPRPLX, WritingSystemPRPLX,
    WritingSystemPRPLX)
forall a.
(a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> [a]
-> ([a], [a], [a], [a])
fHelp4 PhoneticsRepresentationPLX -> Bool
isPRC PhoneticsRepresentationPLX -> Bool
isPRAfterC PhoneticsRepresentationPLX -> Bool
isPRBeforeC PhoneticsRepresentationPLX -> Bool
isPREmptyC WritingSystemPRPLX
rs
                   !r2s :: Array Int PhoneticsRepresentationPLX
r2s = (Int, Int)
-> WritingSystemPRPLX -> Array Int PhoneticsRepresentationPLX
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,WritingSystemPRPLX -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WritingSystemPRPLX
r2ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) WritingSystemPRPLX
r2ls
                   !r3s :: Array Int PhoneticsRepresentationPLX
r3s = (Int, Int)
-> WritingSystemPRPLX -> Array Int PhoneticsRepresentationPLX
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,WritingSystemPRPLX -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WritingSystemPRPLX
r3ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) WritingSystemPRPLX
r3ls
                   !r4s :: Array Int PhoneticsRepresentationPLX
r4s = (Int, Int)
-> WritingSystemPRPLX -> Array Int PhoneticsRepresentationPLX
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,WritingSystemPRPLX -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WritingSystemPRPLX
r4ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) WritingSystemPRPLX
r4ls
                   !r5s :: Array Int PhoneticsRepresentationPLX
r5s = (Int, Int)
-> WritingSystemPRPLX -> Array Int PhoneticsRepresentationPLX
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,WritingSystemPRPLX -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WritingSystemPRPLX
r5ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) WritingSystemPRPLX
r5ls
        
{-| The full conversion function. Applies conversion into representation using the 'GWritingSystemPRPLX' provided.
-}
stringToXG :: GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG :: GWritingSystemPRPLX -> String -> WritingSystemPRPLX
stringToXG GWritingSystemPRPLX
xs String
ys = WritingSystemPRPLX
-> [PhoneticRepresentationXInter] -> WritingSystemPRPLX
fromPhoneticRX WritingSystemPRPLX
ts ([PhoneticRepresentationXInter] -> WritingSystemPRPLX)
-> (String -> [PhoneticRepresentationXInter])
-> String
-> WritingSystemPRPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PhoneticRepresentationXInter, Generations)
 -> PhoneticRepresentationXInter)
-> IGWritingSystemPRPLX -> [PhoneticRepresentationXInter]
forall a b. (a -> b) -> [a] -> [b]
map (PhoneticRepresentationXInter, Generations)
-> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (IGWritingSystemPRPLX -> [PhoneticRepresentationXInter])
-> (String -> IGWritingSystemPRPLX)
-> String
-> [PhoneticRepresentationXInter]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> Generations -> String -> IGWritingSystemPRPLX
stringToXSG GWritingSystemPRPLX
xs Generations
n (String -> WritingSystemPRPLX) -> String -> WritingSystemPRPLX
forall a b. (a -> b) -> a -> b
$ String
ys
 where n :: Generations
n = [Generations] -> Generations
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Generations] -> Generations)
-> (GWritingSystemPRPLX -> [Generations])
-> GWritingSystemPRPLX
-> Generations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WritingSystemPRPLX, Generations) -> Generations)
-> GWritingSystemPRPLX -> [Generations]
forall a b. (a -> b) -> [a] -> [b]
map (WritingSystemPRPLX, Generations) -> Generations
forall a b. (a, b) -> b
snd (GWritingSystemPRPLX -> Generations)
-> GWritingSystemPRPLX -> Generations
forall a b. (a -> b) -> a -> b
$ GWritingSystemPRPLX
xs
       !ts :: WritingSystemPRPLX
ts = ((WritingSystemPRPLX, Generations) -> WritingSystemPRPLX)
-> GWritingSystemPRPLX -> WritingSystemPRPLX
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (WritingSystemPRPLX, Generations) -> WritingSystemPRPLX
forall a b. (a, b) -> a
fst (GWritingSystemPRPLX -> WritingSystemPRPLX)
-> (GWritingSystemPRPLX -> GWritingSystemPRPLX)
-> GWritingSystemPRPLX
-> WritingSystemPRPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WritingSystemPRPLX, Generations) -> Bool)
-> GWritingSystemPRPLX -> GWritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter ((Generations -> Generations -> Bool
forall a. Eq a => a -> a -> Bool
== Generations
0) (Generations -> Bool)
-> ((WritingSystemPRPLX, Generations) -> Generations)
-> (WritingSystemPRPLX, Generations)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WritingSystemPRPLX, Generations) -> Generations
forall a b. (a, b) -> b
snd) (GWritingSystemPRPLX -> WritingSystemPRPLX)
-> GWritingSystemPRPLX -> WritingSystemPRPLX
forall a b. (a -> b) -> a -> b
$ GWritingSystemPRPLX
xs