{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
-- |
-- 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
  --, stringToX
  , string2X
  -- ** Apply conversion from 'PhoneticsRepresentationPLX'.
  , rulesX
) where

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

-- | 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 'PhoneticRepresentationPL' 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)]

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
           xsG :: WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n (String
k1s:String
k2s:String
k3s:[String]
kss) -- xsG :: [PhoneticRepresentationPLX] -> [String] -> Generations -> IGWritingSystemPRPLX
            | (PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k3s Bool -> Bool -> Bool
&& PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s) (String -> Bool)
-> (PhoneticsRepresentationPLX -> String)
-> PhoneticsRepresentationPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX -> String
stringX) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r2s
                = (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)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k3s Bool -> Bool -> Bool
&& PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s Bool -> Bool -> Bool
&&
                    PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r2s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n (String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss)
            | (PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (String -> Bool)
-> (PhoneticsRepresentationPLX -> String)
-> PhoneticsRepresentationPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX -> String
stringX) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r3s
                = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s Bool -> Bool -> Bool
&&
                    PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r3s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss)
            | (PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s) (String -> Bool)
-> (PhoneticsRepresentationPLX -> String)
-> PhoneticsRepresentationPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX -> String
stringX) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r4s
                = (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)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s Bool -> Bool -> Bool
&&
                    PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r4s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n (String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss)
            | (PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (String -> Bool)
-> (PhoneticsRepresentationPLX -> String)
-> PhoneticsRepresentationPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX -> String
stringX) WritingSystemPRPLX
r5s = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r5s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss)
            | 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]
:WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
k3sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss)
               where [!WritingSystemPRPLX
r2s,!WritingSystemPRPLX
r3s,!WritingSystemPRPLX
r4s,!WritingSystemPRPLX
r5s] = ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX)
-> [PhoneticsRepresentationPLX -> Bool] -> [WritingSystemPRPLX]
forall a b. (a -> b) -> [a] -> [b]
map (\PhoneticsRepresentationPLX -> Bool
f -> (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter PhoneticsRepresentationPLX -> Bool
f WritingSystemPRPLX
rs) [PhoneticsRepresentationPLX -> Bool
isPRC, PhoneticsRepresentationPLX -> Bool
isPRAfterC, PhoneticsRepresentationPLX -> Bool
isPRBeforeC, PhoneticsRepresentationPLX -> Bool
isPREmptyC]
           xsG WritingSystemPRPLX
rs a
n (String
k1s:String
k2s:[String]
kss)
            | (PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (String -> Bool)
-> (PhoneticsRepresentationPLX -> String)
-> PhoneticsRepresentationPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX -> String
stringX) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r3s
                = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s Bool -> Bool -> Bool
&&
                    PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r3s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss)
            | (PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s) (String -> Bool)
-> (PhoneticsRepresentationPLX -> String)
-> PhoneticsRepresentationPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX -> String
stringX) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r4s
                = (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)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s Bool -> Bool -> Bool
&&
                    PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k2s) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r4s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n ([String]
kss)
            | (PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (String -> Bool)
-> (PhoneticsRepresentationPLX -> String)
-> PhoneticsRepresentationPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX -> String
stringX) WritingSystemPRPLX
r5s = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r5s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss)
            | 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]
:WritingSystemPRPLX
-> a -> [String] -> [(PhoneticRepresentationXInter, a)]
xsG WritingSystemPRPLX
rs a
n (String
k2sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
kss)
               where [WritingSystemPRPLX
r3s,!WritingSystemPRPLX
r4s,!WritingSystemPRPLX
r5s] = ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX)
-> [PhoneticsRepresentationPLX -> Bool] -> [WritingSystemPRPLX]
forall a b. (a -> b) -> [a] -> [b]
map (\PhoneticsRepresentationPLX -> Bool
f -> (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter PhoneticsRepresentationPLX -> Bool
f WritingSystemPRPLX
rs) [PhoneticsRepresentationPLX -> Bool
isPRAfterC, PhoneticsRepresentationPLX -> Bool
isPRBeforeC, PhoneticsRepresentationPLX -> Bool
isPREmptyC]
           xsG WritingSystemPRPLX
rs a
n [String
k1s]
            | (PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (String -> Bool)
-> (PhoneticsRepresentationPLX -> String)
-> PhoneticsRepresentationPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticsRepresentationPLX -> String
stringX) WritingSystemPRPLX
r5s = [(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k1s) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r5s,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 !r5s :: WritingSystemPRPLX
r5s = (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter PhoneticsRepresentationPLX -> Bool
isPREmptyC WritingSystemPRPLX
rs
           xsG WritingSystemPRPLX
rs a
n [] = []

{-|
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 a.
(Eq a, Num a) =>
WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
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
           xsGI :: WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k1s:(PhoneticRepresentationXInter, a)
k2s:(PhoneticRepresentationXInter, a)
k3s:[(PhoneticRepresentationXInter, a)]
kss) -- xsGI :: [PhoneticRepresentationPLX] -> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX
            | (PhoneticRepresentationXInter, a) -> a
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, a)
k2s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n Bool -> Bool -> Bool
&& ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k3s) Bool -> Bool -> Bool
&&
               (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s)) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r2s) 
                 = ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
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)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k3s) Bool -> Bool -> Bool
&&
                   (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s) Bool -> Bool -> Bool
&& (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s)) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$
                     WritingSystemPRPLX
r2s,a
n) (PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
: WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k3s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, a)]
kss)
            | (PhoneticRepresentationXInter, a) -> a
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, a)
k1s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n Bool -> Bool -> Bool
&& ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s)) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r3s)
                = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s) Bool -> Bool -> Bool
&&
                    (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r3s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k2s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:(PhoneticRepresentationXInter, a)
k3s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, a)]
kss)
            | (PhoneticRepresentationXInter, a) -> a
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, a)
k2s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n Bool -> Bool -> Bool
&& ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s)) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r4s)
                = ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
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)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s) Bool -> Bool -> Bool
&&
                    (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s)) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r4s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k3s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, a)]
kss)
            | (PhoneticRepresentationXInter, a) -> a
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, a)
k1s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n Bool -> Bool -> Bool
&& ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) WritingSystemPRPLX
r5s) = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r5s, a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k2s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:(PhoneticRepresentationXInter, a)
k3s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, a)]
kss)
            | Bool
otherwise = ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
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]
:WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k2s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:(PhoneticRepresentationXInter, a)
k3s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, a)]
kss)
               where [!WritingSystemPRPLX
r2s,!WritingSystemPRPLX
r3s,!WritingSystemPRPLX
r4s,!WritingSystemPRPLX
r5s] = ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX)
-> [PhoneticsRepresentationPLX -> Bool] -> [WritingSystemPRPLX]
forall a b. (a -> b) -> [a] -> [b]
map (\PhoneticsRepresentationPLX -> Bool
f -> (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter PhoneticsRepresentationPLX -> Bool
f WritingSystemPRPLX
rs) [PhoneticsRepresentationPLX -> Bool
isPRC, PhoneticsRepresentationPLX -> Bool
isPRAfterC, PhoneticsRepresentationPLX -> Bool
isPRBeforeC, PhoneticsRepresentationPLX -> Bool
isPREmptyC]
           xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k1s:(PhoneticRepresentationXInter, a)
k2s:[(PhoneticRepresentationXInter, a)]
kss)
            | (PhoneticRepresentationXInter, a) -> a
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, a)
k1s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n Bool -> Bool -> Bool
&& ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s)) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r3s)
                = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
afterStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s) Bool -> Bool -> Bool
&&
                    (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r3s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k2s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, a)]
kss)
            | (PhoneticRepresentationXInter, a) -> a
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, a)
k2s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n Bool -> Bool -> Bool
&& ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> Bool)
-> (WritingSystemPRPLX -> WritingSystemPRPLX)
-> WritingSystemPRPLX
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s)) (WritingSystemPRPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r4s)
                = ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
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)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
beforeStringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s) Bool -> Bool -> Bool
&&
                    (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k2s)) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r4s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ([(PhoneticRepresentationXInter, a)]
kss)
            | (PhoneticRepresentationXInter, a) -> a
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, a)
k1s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n Bool -> Bool -> Bool
&& ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) WritingSystemPRPLX
r5s) = (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r5s,a
n)(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k2s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, a)]
kss)
            | Bool
otherwise = ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
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]
:WritingSystemPRPLX
-> a
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
xsGI WritingSystemPRPLX
rs a
n ((PhoneticRepresentationXInter, a)
k2s(PhoneticRepresentationXInter, a)
-> [(PhoneticRepresentationXInter, a)]
-> [(PhoneticRepresentationXInter, a)]
forall a. a -> [a] -> [a]
:[(PhoneticRepresentationXInter, a)]
kss)
               where [WritingSystemPRPLX
r3s,!WritingSystemPRPLX
r4s,!WritingSystemPRPLX
r5s] = ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX)
-> [PhoneticsRepresentationPLX -> Bool] -> [WritingSystemPRPLX]
forall a b. (a -> b) -> [a] -> [b]
map (\PhoneticsRepresentationPLX -> Bool
f -> (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter PhoneticsRepresentationPLX -> Bool
f WritingSystemPRPLX
rs) [PhoneticsRepresentationPLX -> Bool
isPRAfterC, PhoneticsRepresentationPLX -> Bool
isPRBeforeC, PhoneticsRepresentationPLX -> Bool
isPREmptyC]
           xsGI WritingSystemPRPLX
rs a
n [(PhoneticRepresentationXInter, a)
k1s]
            | (PhoneticRepresentationXInter, a) -> a
forall a b. (a, b) -> b
snd (PhoneticRepresentationXInter, a)
k1s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n Bool -> Bool -> Bool
&& ((PhoneticsRepresentationPLX -> Bool) -> WritingSystemPRPLX -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) WritingSystemPRPLX
r5s) = [(PhoneticsRepresentationPLX -> PhoneticRepresentationXInter
forall a b. a -> Either a b
Left (PhoneticsRepresentationPLX -> PhoneticRepresentationXInter)
-> (WritingSystemPRPLX -> PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticRepresentationXInter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX)
-> (WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX)
-> WritingSystemPRPLX
-> PhoneticsRepresentationPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> Maybe PhoneticsRepresentationPLX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PhoneticsRepresentationPLX
rec -> (PhoneticsRepresentationPLX -> Bool)
-> (String -> Bool) -> PhoneticRepresentationXInter -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> PhoneticsRepresentationPLX -> Bool
forall a b. a -> b -> a
const Bool
False) (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticsRepresentationPLX -> String
stringX PhoneticsRepresentationPLX
rec) ((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s)) (WritingSystemPRPLX -> PhoneticRepresentationXInter)
-> WritingSystemPRPLX -> PhoneticRepresentationXInter
forall a b. (a -> b) -> a -> b
$ WritingSystemPRPLX
r5s,a
n)]
            | Bool
otherwise = [((PhoneticRepresentationXInter, a) -> PhoneticRepresentationXInter
forall a b. (a, b) -> a
fst (PhoneticRepresentationXInter, a)
k1s,a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)]
               where !r5s :: WritingSystemPRPLX
r5s = (PhoneticsRepresentationPLX -> Bool)
-> WritingSystemPRPLX -> WritingSystemPRPLX
forall a. (a -> Bool) -> [a] -> [a]
filter PhoneticsRepresentationPLX -> Bool
isPREmptyC WritingSystemPRPLX
rs
           xsGI WritingSystemPRPLX
rs a
n [] = []
        
{-| 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