{-# OPTIONS_HADDOCK show-extensions #-}
{-# OPTIONS_GHC -funbox-strict-fields -fobject-code #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# 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.
  PhoneticElement(..)
  , 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,intercalate)
import GHC.Int (Int8(..))
import Data.Maybe (isJust,fromJust)
import Data.Either
import Data.Char (isLetter)
import GHC.Arr
import GHC.Exts

-- | 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
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
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
Ord)

instance Show PhoneticsRepresentationPL where
  show :: PhoneticsRepresentationPL -> String
show (PR String
xs String
ys String
zs) = forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String
"R", forall a. Show a => a -> String
show String
zs, forall a. Show a => a -> String
show String
xs, forall a. Show a => a -> String
show String
ys]
  show (PRAfter String
xs String
ys) = forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String
"A", forall a. Show a => a -> String
show String
xs, forall a. Show a => a -> String
show String
ys]
  show (PRBefore String
xs String
zs) = forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String
"B", forall a. Show a => a -> String
show String
zs, forall a. Show a => a -> String
show String
xs]
  show (PREmpty String
xs) = String
"E " forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show String
xs

class PhoneticElement a where
  readPEMaybe :: String -> Maybe a

instance PhoneticElement PhoneticsRepresentationPL where
  readPEMaybe :: String -> Maybe PhoneticsRepresentationPL
readPEMaybe String
rs
    | Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isLetter forall a b. (a -> b) -> a -> b
$ String
rs = forall a. Maybe a
Nothing
    | Bool
otherwise = case String
ys of
        String
"R" -> case [String]
yss of
           [String
zs,String
xs,String
ts] -> forall a. a -> Maybe a
Just (String -> String -> String -> PhoneticsRepresentationPL
PR String
xs String
ts String
zs)
           [String]
_ -> forall a. Maybe a
Nothing
        String
"A" -> case [String]
yss of
           [String
xs,String
ts] -> forall a. a -> Maybe a
Just (String -> String -> PhoneticsRepresentationPL
PRAfter String
xs String
ts)
           [String]
_ -> forall a. Maybe a
Nothing
        String
"B" -> case [String]
yss of
           [String
zs,String
xs] -> forall a. a -> Maybe a
Just (String -> String -> PhoneticsRepresentationPL
PRBefore String
xs String
zs)
           [String]
_ -> forall a. Maybe a
Nothing
        String
"E" -> case [String]
yss of
           [String
xs] -> forall a. a -> Maybe a
Just (String -> PhoneticsRepresentationPL
PREmpty String
xs)
           [String]
_ -> forall a. Maybe a
Nothing
        String
_ -> forall a. Maybe a
Nothing
       where (String
ys:[String]
yss) = String -> [String]
words String
rs  

-- | 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. While the 'char' function can be used to group 'PhoneticRepresentationPLX'
-- that represents some phenomenae, for the phonetic languages approach the 'string1' is used in the most cases.
data PhoneticsRepresentationPLX = PRC { PhoneticsRepresentationPLX -> String
stringX :: String, PhoneticsRepresentationPLX -> String
afterStringX :: String, PhoneticsRepresentationPLX -> String
beforeStringX :: String, PhoneticsRepresentationPLX -> Char
char :: Char, PhoneticsRepresentationPLX -> String
string1 :: String } |
  PRAfterC { stringX :: String, afterStringX :: String, char :: Char, string1 :: String } |
  PRBeforeC { stringX :: String, beforeStringX :: String, char :: Char, string1 :: String } |
  PREmptyC { stringX :: String, char :: Char, string1 :: String }
    deriving (PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX -> Bool
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
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
Ord)

instance Show PhoneticsRepresentationPLX where
  show :: PhoneticsRepresentationPLX -> String
show (PRC String
xs String
ys String
zs Char
c String
us) = forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String
"RC", forall a. Show a => a -> String
show String
zs, forall a. Show a => a -> String
show String
xs, forall a. Show a => a -> String
show String
ys, Char
'\''forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:String
"\'", String
us]
  show (PRAfterC String
xs String
ys Char
c String
us) = forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String
"AC", forall a. Show a => a -> String
show String
xs, forall a. Show a => a -> String
show String
ys, Char
'\''forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:String
"\'", String
us]
  show (PRBeforeC String
xs String
zs Char
c String
us) = forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String
"BC", forall a. Show a => a -> String
show String
zs, forall a. Show a => a -> String
show String
xs, Char
'\''forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:String
"\'", String
us]
  show (PREmptyC String
xs Char
c String
us) = String
"EC " forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show String
xs forall a. Monoid a => a -> a -> a
`mappend` (Char
' 'forall a. a -> [a] -> [a]
:Char
'\''forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:String
"\'") forall a. Monoid a => a -> a -> a
`mappend` String
us

instance PhoneticElement PhoneticsRepresentationPLX where
  readPEMaybe :: String -> Maybe PhoneticsRepresentationPLX
readPEMaybe String
rs
    | Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isLetter forall a b. (a -> b) -> a -> b
$ String
rs = forall a. Maybe a
Nothing
    | Bool
otherwise = case String
ys of
        String
"RC" -> case [String]
yss of
           [String
zs,String
xs,String
ts,String
cs,String
us] -> case String
cs of
               Char
'\'':Char
c:String
"\'" -> forall a. a -> Maybe a
Just (String
-> String -> String -> Char -> String -> PhoneticsRepresentationPLX
PRC String
xs String
ts String
zs Char
c String
us)
               String
_ -> forall a. Maybe a
Nothing
           [String]
_ -> forall a. Maybe a
Nothing
        String
"AC" -> case [String]
yss of
           [String
xs,String
ts,String
cs,String
us] -> case String
cs of
               Char
'\'':Char
c:String
"\'" -> forall a. a -> Maybe a
Just (String -> String -> Char -> String -> PhoneticsRepresentationPLX
PRAfterC String
xs String
ts Char
c String
us)
               String
_ -> forall a. Maybe a
Nothing
           [String]
_ -> forall a. Maybe a
Nothing
        String
"BC" -> case [String]
yss of
           [String
zs,String
xs,String
cs,String
us] -> case String
cs of
               Char
'\'':Char
c:String
"\'" -> forall a. a -> Maybe a
Just (String -> String -> Char -> String -> PhoneticsRepresentationPLX
PRBeforeC String
xs String
zs Char
c String
us)
               String
_ -> forall a. Maybe a
Nothing
           [String]
_ -> forall a. Maybe a
Nothing
        String
"EC" -> case [String]
yss of
           [String
xs,String
cs,String
us] -> case String
cs of
               Char
'\'':Char
c:String
"\'" -> forall a. a -> Maybe a
Just (String -> Char -> String -> PhoneticsRepresentationPLX
PREmptyC String
xs Char
c String
us)
               String
_ -> forall a. Maybe a
Nothing
           [String]
_ -> forall a. Maybe a
Nothing
        String
_ -> forall a. Maybe a
Nothing
       where (String
ys:[String]
yss) = String -> [String]
words String
rs    

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

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

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

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

fromX2PRPL :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPL
fromX2PRPL :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPL
fromX2PRPL (PREmptyC String
xs Char
_ String
_) = String -> PhoneticsRepresentationPL
PREmpty String
xs
fromX2PRPL (PRAfterC String
xs String
ys Char
_ String
_) = String -> String -> PhoneticsRepresentationPL
PRAfter String
xs String
ys
fromX2PRPL (PRBeforeC String
xs String
zs Char
_ String
_) = String -> String -> PhoneticsRepresentationPL
PRBefore String
xs String
zs
fromX2PRPL (PRC String
xs String
ys String
zs Char
_ String
_) = 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 :: [PhoneticsRepresentationPLX] -> String -> [String]
stringToXS [PhoneticsRepresentationPLX]
xs String
ys = String
ks forall a. a -> [a] -> [a]
: forall {t :: * -> *} {a}.
(Foldable t, Eq a) =>
t [a] -> Int -> [a] -> [[a]]
stringToX' [String]
zss Int
l String
ts
  where !zss :: [String]
zss = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PhoneticsRepresentationPLX -> String
stringX forall a b. (a -> b) -> a -> b
$ [PhoneticsRepresentationPLX]
xs
        !l :: Int
l = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ [String]
zss
        f :: [a] -> Int -> t [a] -> ([a], [a])
f [a]
ys Int
l t [a]
zss = forall a. Int -> [a] -> ([a], [a])
splitAt ((\[Int]
xs -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs then Int
1 else forall a. [a] -> a
head [Int]
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
n -> forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a. Int -> [a] -> [a]
take Int
n [a]
ys) t [a]
zss) forall a b. (a -> b) -> a -> b
$ [Int
l,Int
lforall a. Num a => a -> a -> a
-Int
1..Int
1]) [a]
ys
        {-# INLINE f #-}
        (!String
ks,!String
ts) = 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 forall a. a -> [a] -> [a]
: t [a] -> Int -> [a] -> [[a]]
stringToX' t [a]
rss Int
m [a]
us
           where (![a]
bs,![a]
us) = 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 :: [PhoneticsRepresentationPLX]
-> String -> [PhoneticsRepresentationPLX]
string2X [PhoneticsRepresentationPLX]
xs = GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG [([PhoneticsRepresentationPLX]
zs,Generations
1),([PhoneticsRepresentationPLX]
ys,Generations
0)]
  where ([PhoneticsRepresentationPLX]
ys,[PhoneticsRepresentationPLX]
zs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition PhoneticsRepresentationPLX -> Bool
isPREmptyC [PhoneticsRepresentationPLX]
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)]

{-| The intermediate representation of the phonetic languages data. Is used during conversions.
-}
type PhoneticRepresentationXInter = Either PhoneticsRepresentationPLX InterGenerationsString

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

-- | Splits the given list using 4 predicates into tuple of 4 lists of elements satisfying the predicates in the order
-- being preserved.
fHelp4 :: (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> [a] -> ([a],[a],[a],[a])
fHelp4 :: forall a.
(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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ([a], [a], [a], [a]) -> ([a], [a], [a], [a])
g 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
xforall a. a -> [a] -> [a]
:[a]
xs1,[a]
xs2,[a]
xs3,[a]
xs4)
          | a -> Bool
p2 a
x = ([a]
xs1,a
xforall a. a -> [a] -> [a]
:[a]
xs2,[a]
xs3,[a]
xs4)
          | a -> Bool
p3 a
x = ([a]
xs1,[a]
xs2,a
xforall a. a -> [a] -> [a]
:[a]
xs3,[a]
xs4)
          | a -> Bool
p4 a
x = ([a]
xs1,[a]
xs2,[a]
xs3,a
xforall 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
-- 'PhoneticsRepresentationPLX' values. 
(~=) :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Bool
(PR String
xs String
ys String
zs) ~= :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Bool
~= (PRC String
xs1 String
ys1 String
zs1 Char
_ String
_) = String
xs forall a. Eq a => a -> a -> Bool
== String
xs1 Bool -> Bool -> Bool
&& String
ys forall a. Eq a => a -> a -> Bool
== String
ys1 Bool -> Bool -> Bool
&& String
zs forall a. Eq a => a -> a -> Bool
== String
zs1
(PRAfter String
xs String
ys) ~= (PRAfterC String
xs1 String
ys1 Char
_ String
_) = String
xs forall a. Eq a => a -> a -> Bool
== String
xs1 Bool -> Bool -> Bool
&& String
ys forall a. Eq a => a -> a -> Bool
== String
ys1
(PRBefore String
ys String
zs) ~= (PRBeforeC String
ys1 String
zs1 Char
_ String
_) = String
ys forall a. Eq a => a -> a -> Bool
== String
ys1 Bool -> Bool -> Bool
&& String
zs forall a. Eq a => a -> a -> Bool
== String
zs1
(PREmpty String
xs) ~= (PREmptyC String
xs1 Char
_ String
_) = String
xs1 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
-- 'PhoneticsRepresentationPLX' 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
_)
 | String
xs forall a. Eq a => a -> a -> Bool
/= String
xs1 = forall a. Ord a => a -> a -> Ordering
compare String
xs String
xs1
 | String
ys forall a. Eq a => a -> a -> Bool
/= String
ys1 = forall a. Ord a => a -> a -> Ordering
compare String
ys String
ys1
 | String
zs forall a. Eq a => a -> a -> Bool
/= String
zs1 = 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
_)
 | String
xs forall a. Eq a => a -> a -> Bool
/= String
xs1 = 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
_)
 | String
xs forall a. Eq a => a -> a -> Bool
/= String
xs1 = forall a. Ord a => a -> a -> Ordering
compare String
xs String
xs1
 | String
ys forall a. Eq a => a -> a -> Bool
/= String
ys1 = 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
_ String
_) = Ordering
GT
compareG (PRAfter String
_ String
_) PhoneticsRepresentationPLX
_ = Ordering
LT
compareG (PRBefore String
ys String
zs) (PRBeforeC String
ys1 String
zs1 Char
_ String
_)
 | String
ys forall a. Eq a => a -> a -> Bool
/= String
ys1 = forall a. Ord a => a -> a -> Ordering
compare String
ys String
ys1
 | String
zs forall a. Eq a => a -> a -> Bool
/= String
zs1 = forall a. Ord a => a -> a -> Ordering
compare String
zs String
zs1
 | Bool
otherwise = Ordering
EQ
compareG (PRBefore String
_ String
_) (PREmptyC String
_ Char
_ String
_) = 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
  :: (Ix i) => (# Int#, PhoneticsRepresentationPLX #)
  -> (# Int#, PhoneticsRepresentationPLX #)
  -> PhoneticsRepresentationPL
  -> Array i PhoneticsRepresentationPLX
  -> Maybe PhoneticsRepresentationPLX
gBF3 :: forall i.
Ix i =>
(# 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 -> forall i.
Ix 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  -> forall i.
Ix 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
_ -> forall a. a -> Maybe a
Just PhoneticsRepresentationPLX
p
 | PhoneticsRepresentationPL
repr PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Bool
~= PhoneticsRepresentationPLX
m = forall a. a -> Maybe a
Just PhoneticsRepresentationPLX
m
 | PhoneticsRepresentationPL
repr PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Bool
~= PhoneticsRepresentationPLX
k = forall a. a -> Maybe a
Just PhoneticsRepresentationPLX
k
 | Bool
otherwise = 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 = 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 = forall i.
Ix 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#) = forall i e. Array i e -> (i, i)
bounds Array Int PhoneticsRepresentationPLX
arr
           !k :: PhoneticsRepresentationPLX
k = forall i e. Array i e -> Int -> e
unsafeAt Array Int PhoneticsRepresentationPLX
arr (Int# -> Int
I# Int#
i#)
           !m :: PhoneticsRepresentationPLX
m = forall i e. Array i e -> Int -> e
unsafeAt Array Int PhoneticsRepresentationPLX
arr (Int# -> Int
I# Int#
i#)

{- The following CPP macros contents is taken from the 'Data.Either' module from @base@ package.
-}
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__<802
fromLeft :: a -> Either a b -> a
fromLeft _ (Left x) = x
fromLeft def _ = def

fromRight :: b -> Either a b -> b
fromRight _ (Right x) = x
fromRight def _ = def
#endif
#endif

-- | Finds and element in the 'Array' that the corresponding 'PhoneticsRepresentationPLX' from the first argument is '~=' to the
-- it. The 'String' arguments inside the tuple pair are the 'beforeString' and the 'afterString' elements of it to be used in 'Right'
-- case.
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
 | forall a b. Either a b -> Bool
isLeft PhoneticRepresentationXInter
repr = forall i.
Ix i =>
(# Int#, PhoneticsRepresentationPLX #)
-> (# Int#, PhoneticsRepresentationPLX #)
-> PhoneticsRepresentationPL
-> Array i PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
gBF3 (# Int#
i#, PhoneticsRepresentationPLX
k #) (# Int#
j#, PhoneticsRepresentationPLX
m #) (PhoneticsRepresentationPLX -> PhoneticsRepresentationPL
fromX2PRPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b -> a
fromLeft (String -> Char -> String -> PhoneticsRepresentationPLX
PREmptyC String
" " Char
' ' String
" ") forall a b. (a -> b) -> a -> b
$ PhoneticRepresentationXInter
repr) Array Int PhoneticsRepresentationPLX
arr
 | Bool
otherwise = forall i.
Ix 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 (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#) = forall i e. Array i e -> (i, i)
bounds Array Int PhoneticsRepresentationPLX
arr
           !k :: PhoneticsRepresentationPLX
k = forall i e. Array i e -> Int -> e
unsafeAt Array Int PhoneticsRepresentationPLX
arr (Int# -> Int
I# Int#
i#)
           !m :: PhoneticsRepresentationPLX
m = 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
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== Generations
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) GWritingSystemPRPLX
xs Bool -> Bool -> Bool
&& Generations
n forall a. Ord a => a -> a -> Bool
> Generations
0 = GWritingSystemPRPLX
-> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
stringToXSGI (GWritingSystemPRPLX
xs forall a. Eq a => [a] -> [a] -> [a]
\\ GWritingSystemPRPLX
ts) (Generations
n forall a. Num a => a -> a -> a
- Generations
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t}.
Num t =>
[PhoneticsRepresentationPLX]
-> t -> [String] -> [(PhoneticRepresentationXInter, t)]
xsG [PhoneticsRepresentationPLX]
zs Generations
n forall a b. (a -> b) -> a -> b
$ [String]
pss
 | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Data.Phonetic.Languages.Base.stringToXSG: Not defined for these first two arguments. "
    where !pss :: [String]
pss = [PhoneticsRepresentationPLX] -> String -> [String]
stringToXS (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst GWritingSystemPRPLX
xs) String
ys -- ps :: [String]
          !ts :: GWritingSystemPRPLX
ts = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Generations
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ GWritingSystemPRPLX
xs -- ts :: GWritingSystemPRPLX
          !zs :: [PhoneticsRepresentationPLX]
zs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null GWritingSystemPRPLX
ts then [] else forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ GWritingSystemPRPLX
ts -- zs :: PhoneticRepresentationX
          xsG1 :: t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
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
            | forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x1 = (forall a b. b -> Either a b
Right String
k1s,t
n forall a. Num a => a -> a -> a
- t
1)forall a. a -> [a] -> [a]
:(forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x1,t
n)forall a. a -> [a] -> [a]
:t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
n (String
k3sforall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x2 = (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x2,t
n)forall a. a -> [a] -> [a]
:t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
n (String
k2sforall a. a -> [a] -> [a]
:String
k3sforall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x3 = (forall a b. b -> Either a b
Right String
k1s,t
n forall a. Num a => a -> a -> a
- t
1)forall a. a -> [a] -> [a]
:(forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x3,t
n)forall a. a -> [a] -> [a]
:t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
n (String
k3sforall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,t
n)forall a. a -> [a] -> [a]
:t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
n (String
k2sforall a. a -> [a] -> [a]
:String
k3sforall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Bool
otherwise = (forall a b. b -> Either a b
Right String
k1s,t
n forall a. Num a => a -> a -> a
- t
1)forall a. a -> [a] -> [a]
:t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
n (String
k2sforall a. a -> [a] -> [a]
:String
k3sforall 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 t
n (String
k1s:String
k2s:[String]
kss) (!Array Int PhoneticsRepresentationPLX
r2s,!Array Int PhoneticsRepresentationPLX
r3s,!Array Int PhoneticsRepresentationPLX
r4s,!Array Int PhoneticsRepresentationPLX
r5s)
            | forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x2 = (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x2,t
n)forall a. a -> [a] -> [a]
:t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
n (String
k2sforall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x3 = (forall a b. b -> Either a b
Right String
k1s,t
n forall a. Num a => a -> a -> a
- t
1)forall a. a -> [a] -> [a]
:(forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x3,t
n)forall a. a -> [a] -> [a]
:t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
n [String]
kss (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,t
n)forall a. a -> [a] -> [a]
:t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
n (String
k2sforall a. a -> [a] -> [a]
:[String]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | Bool
otherwise = (forall a b. b -> Either a b
Right String
k1s,t
n forall a. Num a => a -> a -> a
- t
1)forall a. a -> [a] -> [a]
:t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 t
rs t
n (String
k2sforall 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 t
n [String
k1s] (Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = [(forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,t
n)]
            | Bool
otherwise = [(forall a b. b -> Either a b
Right String
k1s,t
n forall a. Num a => a -> a -> a
- t
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 t
n [] (Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_,Array Int PhoneticsRepresentationPLX
_) = []
          xsG :: [PhoneticsRepresentationPLX]
-> t -> [String] -> [(PhoneticRepresentationXInter, t)]
xsG [PhoneticsRepresentationPLX]
rs t
n [String]
jss = forall {t} {t}.
Num t =>
t
-> t
-> [String]
-> (Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX,
    Array Int PhoneticsRepresentationPLX)
-> [(PhoneticRepresentationXInter, t)]
xsG1 [PhoneticsRepresentationPLX]
rs t
n [String]
jss (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            where (![PhoneticsRepresentationPLX]
r2ls,![PhoneticsRepresentationPLX]
r3ls,![PhoneticsRepresentationPLX]
r4ls,![PhoneticsRepresentationPLX]
r5ls) = 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 [PhoneticsRepresentationPLX]
rs
                  !r2s :: Array Int PhoneticsRepresentationPLX
r2s = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [PhoneticsRepresentationPLX]
r2ls forall a. Num a => a -> a -> a
- Int
1) [PhoneticsRepresentationPLX]
r2ls
                  !r3s :: Array Int PhoneticsRepresentationPLX
r3s = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [PhoneticsRepresentationPLX]
r3ls forall a. Num a => a -> a -> a
- Int
1) [PhoneticsRepresentationPLX]
r3ls
                  !r4s :: Array Int PhoneticsRepresentationPLX
r4s = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [PhoneticsRepresentationPLX]
r4ls forall a. Num a => a -> a -> a
- Int
1) [PhoneticsRepresentationPLX]
r4ls
                  !r5s :: Array Int PhoneticsRepresentationPLX
r5s = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [PhoneticsRepresentationPLX]
r5ls forall a. Num a => a -> a -> a
- Int
1) [PhoneticsRepresentationPLX]
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 forall a. Ord a => a -> a -> Bool
> Generations
0 = GWritingSystemPRPLX
-> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
stringToXSGI (GWritingSystemPRPLX
xs forall a. Eq a => [a] -> [a] -> [a]
\\ GWritingSystemPRPLX
ts) (Generations
n forall a. Num a => a -> a -> a
- Generations
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}.
(Eq b, Num b) =>
[PhoneticsRepresentationPLX]
-> b
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
xsGI [PhoneticsRepresentationPLX]
zs Generations
n forall a b. (a -> b) -> a -> b
$ IGWritingSystemPRPLX
ys
 | Bool
otherwise = IGWritingSystemPRPLX
ys
     where !ts :: GWritingSystemPRPLX
ts = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Generations
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) GWritingSystemPRPLX
xs -- ts :: GWritingSystemPRPLX
           !zs :: [PhoneticsRepresentationPLX]
zs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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
            | forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k2s forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x1 = (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n forall a. Num a => a -> a -> a
- b
1)forall a. a -> [a] -> [a]
:(forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x1,b
n) 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)
k3sforall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x2 = (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x2,b
n)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)
k2sforall a. a -> [a] -> [a]
:(PhoneticRepresentationXInter, b)
k3sforall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k2s forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x3 = (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n forall a. Num a => a -> a -> a
- b
1)forall a. a -> [a] -> [a]
:(forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x3 ,b
n)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)
k3sforall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4, b
n)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)
k2sforall a. a -> [a] -> [a]
:(PhoneticRepresentationXInter, b)
k3sforall 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 = (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n forall a. Num a => a -> a -> a
- b
1)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)
k2sforall a. a -> [a] -> [a]
:(PhoneticRepresentationXInter, b)
k3sforall 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 (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k2s) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ (PhoneticRepresentationXInter, b)
k1s,forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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 (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s) ([],forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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 (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k2s) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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 (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)
            | forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x2 = (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x2,b
n)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)
k2sforall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, b)]
kss) (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
            | forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k2s forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x3 = (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n forall a. Num a => a -> a -> a
- b
1)forall a. a -> [a] -> [a]
:(forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x3,b
n)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)
            | forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,b
n)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)
k2sforall 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 = (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n forall a. Num a => a -> a -> a
- b
1)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)
k2sforall 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 (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s) ([],forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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 (forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k2s) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PhoneticsRepresentationPLX -> String
stringX forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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 (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)
            | forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, b)
k1s forall a. Eq a => a -> a -> Bool
== b
n Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe PhoneticsRepresentationPLX
x4 = [(forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PhoneticsRepresentationPLX
x4,b
n)]
            | Bool
otherwise = [(forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, b)
k1s,b
n forall a. Num a => a -> a -> a
- b
1)]
                where !x4 :: Maybe PhoneticsRepresentationPLX
x4 = PhoneticRepresentationXInter
-> (String, String)
-> Array Int PhoneticsRepresentationPLX
-> Maybe PhoneticsRepresentationPLX
findSAI (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 :: [PhoneticsRepresentationPLX]
-> b
-> [(PhoneticRepresentationXInter, b)]
-> [(PhoneticRepresentationXInter, b)]
xsGI [PhoneticsRepresentationPLX]
rs b
n [(PhoneticRepresentationXInter, b)]
jss = 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 [PhoneticsRepresentationPLX]
rs b
n [(PhoneticRepresentationXInter, b)]
jss (Array Int PhoneticsRepresentationPLX
r2s,Array Int PhoneticsRepresentationPLX
r3s,Array Int PhoneticsRepresentationPLX
r4s,Array Int PhoneticsRepresentationPLX
r5s)
             where (![PhoneticsRepresentationPLX]
r2ls,![PhoneticsRepresentationPLX]
r3ls,![PhoneticsRepresentationPLX]
r4ls,![PhoneticsRepresentationPLX]
r5ls) = 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 [PhoneticsRepresentationPLX]
rs
                   !r2s :: Array Int PhoneticsRepresentationPLX
r2s = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [PhoneticsRepresentationPLX]
r2ls forall a. Num a => a -> a -> a
- Int
1) [PhoneticsRepresentationPLX]
r2ls
                   !r3s :: Array Int PhoneticsRepresentationPLX
r3s = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [PhoneticsRepresentationPLX]
r3ls forall a. Num a => a -> a -> a
- Int
1) [PhoneticsRepresentationPLX]
r3ls
                   !r4s :: Array Int PhoneticsRepresentationPLX
r4s = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [PhoneticsRepresentationPLX]
r4ls forall a. Num a => a -> a -> a
- Int
1) [PhoneticsRepresentationPLX]
r4ls
                   !r5s :: Array Int PhoneticsRepresentationPLX
r5s = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [PhoneticsRepresentationPLX]
r5ls forall a. Num a => a -> a -> a
- Int
1) [PhoneticsRepresentationPLX]
r5ls
        
-- | The full conversion function. Applies conversion into representation using the 'GWritingSystemPRPLX' provided.
stringToXG :: GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG :: GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
xs String
ys = [PhoneticsRepresentationPLX]
-> [PhoneticRepresentationXInter] -> [PhoneticsRepresentationPLX]
fromPhoneticRX [PhoneticsRepresentationPLX]
ts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> Generations -> String -> IGWritingSystemPRPLX
stringToXSG GWritingSystemPRPLX
xs Generations
n forall a b. (a -> b) -> a -> b
$ String
ys
 where n :: Generations
n = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ GWritingSystemPRPLX
xs
       !ts :: [PhoneticsRepresentationPLX]
ts = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Generations
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ GWritingSystemPRPLX
xs