{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -funbox-strict-fields -fobject-code #-}
{-# OPTIONS_HADDOCK show-extensions #-}

{- |
Module      :  Aftovolio.General.Syllables
Copyright   :  (c) Oleksandr Zhabenko 2021-2024
License     :  MIT
Stability   :  Experimental
Maintainer  :  oleksandr.zhabenko@yahoo.com

This module works with syllable segmentation. The generalized version for the module
'Aftovolio.Ukrainian.Syllable' from @ukrainian-phonetics-basic-array@ package.
-}
module Aftovolio.General.Syllables (
    -- * Data types and type synonyms
    PRS (..),
    PhoneticType (..),
    CharPhoneticClassification,
    StringRepresentation,
    SegmentationInfo1 (..),
    SegmentationPredFunction (..),
    SegmentationPredFData (..),
    SegmentationFDP,
    Eval2Bool (..),
    DListFunctionResult,
    SegmentationLineFunction (..),
    SegmentationRules1 (..),
    SegmentRulesG,
    DListRepresentation (..),

    -- * Basic functions
    str2PRSs,
    sndGroups,
    groupSnds,
    divCnsnts,
    reSyllableCntnts,
    divSylls,
    createSyllablesPL,

    -- * Auxiliary functions
    gBF4,
    findC,
    createsSyllable,
    isSonorous1,
    isVoicedC1,
    isVoicelessC1,
    notCreatesSyllable2,
    notEqC,
    fromPhoneticType,
) where

import Aftovolio.General.Base
import CaseBi.Arr
import Data.Char (isLetter)
import Data.IntermediateStructures1 (mapI)
import qualified Data.List as L (find, groupBy, intercalate, words)
import Data.Maybe (fromJust, mapMaybe)
import Data.Tuple (fst, snd)
import GHC.Arr
import GHC.Base
import GHC.Enum (fromEnum)
import GHC.Exts
import GHC.Int
import GHC.List
import GHC.Num ((-))
import Text.Read (Read (..), readMaybe)
import Text.Show (Show (..))

-- Inspired by: https://github.com/OleksandrZhabenko/mm1/releases/tag/0.2.0.0

-- CAUTION: Please, do not mix with the show7s functions, they are not interoperable.

data PRS = SylS
    { PRS -> Char
charS :: {-# UNPACK #-} !Char
    -- ^ Phonetic languages phenomenon representation. Usually, a phoneme, but it can be otherwise something different.
    , PRS -> PhoneticType
phoneType :: {-# UNPACK #-} !PhoneticType
    -- ^ Some encoded type. For the vowels it has reserved value of 'P' 0, for the sonorous consonants - 'P' 1 and 'P' 2,
    -- for the voiced consonants - 'P' 3 and 'P' 4, for the voiceless consonants - 'P' 5 and 'P' 6. Nevertheless, it is possible to redefine the data by rewriting the
    -- respective parts of the code here.
    }
    deriving (PRS -> PRS -> Bool
(PRS -> PRS -> Bool) -> (PRS -> PRS -> Bool) -> Eq PRS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PRS -> PRS -> Bool
== :: PRS -> PRS -> Bool
$c/= :: PRS -> PRS -> Bool
/= :: PRS -> PRS -> Bool
Eq, ReadPrec [PRS]
ReadPrec PRS
Int -> ReadS PRS
ReadS [PRS]
(Int -> ReadS PRS)
-> ReadS [PRS] -> ReadPrec PRS -> ReadPrec [PRS] -> Read PRS
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PRS
readsPrec :: Int -> ReadS PRS
$creadList :: ReadS [PRS]
readList :: ReadS [PRS]
$creadPrec :: ReadPrec PRS
readPrec :: ReadPrec PRS
$creadListPrec :: ReadPrec [PRS]
readListPrec :: ReadPrec [PRS]
Read)

instance Ord PRS where
    compare :: PRS -> PRS -> Ordering
compare (SylS Char
x1 PhoneticType
y1) (SylS Char
x2 PhoneticType
y2) =
        case Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Char
x1 Char
x2 of
            Ordering
EQ -> PhoneticType -> PhoneticType -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PhoneticType
y1 PhoneticType
y2
            ~Ordering
z -> Ordering
z

instance Show PRS where
    show :: PRS -> String
show (SylS Char
c (P Int8
x)) = String
"SylS \'" String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Int8 -> String
forall a. Show a => a -> String
show Int8
x)

data PhoneticType = P {-# UNPACK #-} !Int8 deriving (PhoneticType -> PhoneticType -> Bool
(PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> Bool) -> Eq PhoneticType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhoneticType -> PhoneticType -> Bool
== :: PhoneticType -> PhoneticType -> Bool
$c/= :: PhoneticType -> PhoneticType -> Bool
/= :: PhoneticType -> PhoneticType -> Bool
Eq, Eq PhoneticType
Eq PhoneticType
-> (PhoneticType -> PhoneticType -> Ordering)
-> (PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> PhoneticType)
-> (PhoneticType -> PhoneticType -> PhoneticType)
-> Ord PhoneticType
PhoneticType -> PhoneticType -> Bool
PhoneticType -> PhoneticType -> Ordering
PhoneticType -> PhoneticType -> PhoneticType
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
$ccompare :: PhoneticType -> PhoneticType -> Ordering
compare :: PhoneticType -> PhoneticType -> Ordering
$c< :: PhoneticType -> PhoneticType -> Bool
< :: PhoneticType -> PhoneticType -> Bool
$c<= :: PhoneticType -> PhoneticType -> Bool
<= :: PhoneticType -> PhoneticType -> Bool
$c> :: PhoneticType -> PhoneticType -> Bool
> :: PhoneticType -> PhoneticType -> Bool
$c>= :: PhoneticType -> PhoneticType -> Bool
>= :: PhoneticType -> PhoneticType -> Bool
$cmax :: PhoneticType -> PhoneticType -> PhoneticType
max :: PhoneticType -> PhoneticType -> PhoneticType
$cmin :: PhoneticType -> PhoneticType -> PhoneticType
min :: PhoneticType -> PhoneticType -> PhoneticType
Ord, ReadPrec [PhoneticType]
ReadPrec PhoneticType
Int -> ReadS PhoneticType
ReadS [PhoneticType]
(Int -> ReadS PhoneticType)
-> ReadS [PhoneticType]
-> ReadPrec PhoneticType
-> ReadPrec [PhoneticType]
-> Read PhoneticType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PhoneticType
readsPrec :: Int -> ReadS PhoneticType
$creadList :: ReadS [PhoneticType]
readList :: ReadS [PhoneticType]
$creadPrec :: ReadPrec PhoneticType
readPrec :: ReadPrec PhoneticType
$creadListPrec :: ReadPrec [PhoneticType]
readListPrec :: ReadPrec [PhoneticType]
Read)

instance Show PhoneticType where
    show :: PhoneticType -> String
show (P Int8
x) = Char
'P' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Int8 -> String
forall a. Show a => a -> String
show Int8
x

fromPhoneticType :: PhoneticType -> Int
fromPhoneticType :: PhoneticType -> Int
fromPhoneticType (P Int8
x) = Int8 -> Int
forall a. Enum a => a -> Int
fromEnum Int8
x

-- | The 'Array' 'Int' must be sorted in the ascending order to be used in the module correctly.
type CharPhoneticClassification = Array Int PRS

{- | The 'String' of converted phonetic language representation 'Char' data is converted to this type to apply syllable
segmentation or other transformations.
-}
type StringRepresentation = [PRS]

-- | Is somewhat rewritten from the 'CaseBi.Arr.gBF3' function (not exported) from the @mmsyn2-array@ package.
gBF4 ::
    (Ix i) =>
    (# Int#, PRS #) ->
    (# Int#, PRS #) ->
    Char ->
    Array i PRS ->
    Maybe PRS
gBF4 :: forall i.
Ix i =>
(# Int#, PRS #)
-> (# Int#, PRS #) -> Char -> Array i PRS -> Maybe PRS
gBF4 (# !Int#
i#, PRS
k #) (# !Int#
j#, PRS
m #) Char
c Array i PRS
arr
    | Int# -> Bool
isTrue# ((Int#
j# Int# -> Int# -> Int#
-# Int#
i#) Int# -> Int# -> Int#
># Int#
1#) =
        case Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Char
c (PRS -> Char
charS PRS
p) of
            Ordering
GT -> (# Int#, PRS #)
-> (# Int#, PRS #) -> Char -> Array i PRS -> Maybe PRS
forall i.
Ix i =>
(# Int#, PRS #)
-> (# Int#, PRS #) -> Char -> Array i PRS -> Maybe PRS
gBF4 (# Int#
n#, PRS
p #) (# Int#
j#, PRS
m #) Char
c Array i PRS
arr
            Ordering
LT -> (# Int#, PRS #)
-> (# Int#, PRS #) -> Char -> Array i PRS -> Maybe PRS
forall i.
Ix i =>
(# Int#, PRS #)
-> (# Int#, PRS #) -> Char -> Array i PRS -> Maybe PRS
gBF4 (# Int#
i#, PRS
k #) (# Int#
n#, PRS
p #) Char
c Array i PRS
arr
            Ordering
_ -> PRS -> Maybe PRS
forall a. a -> Maybe a
Just PRS
p
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== PRS -> Char
charS PRS
m = PRS -> Maybe PRS
forall a. a -> Maybe a
Just PRS
m
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== PRS -> Char
charS PRS
k = PRS -> Maybe PRS
forall a. a -> Maybe a
Just PRS
k
    | Bool
otherwise = Maybe PRS
forall a. Maybe a
Nothing
  where
    !n# :: Int#
n# = (Int#
i# Int# -> Int# -> Int#
+# Int#
j#) Int# -> Int# -> Int#
`quotInt#` Int#
2#
    !p :: PRS
p = Array i PRS -> Int -> PRS
forall i e. Array i e -> Int -> e
unsafeAt Array i PRS
arr (Int# -> Int
I# Int#
n#)

findC ::
    Char ->
    Array Int PRS ->
    Maybe PRS
findC :: Char -> Array Int PRS -> Maybe PRS
findC Char
c Array Int PRS
arr = (# Int#, PRS #)
-> (# Int#, PRS #) -> Char -> Array Int PRS -> Maybe PRS
forall i.
Ix i =>
(# Int#, PRS #)
-> (# Int#, PRS #) -> Char -> Array i PRS -> Maybe PRS
gBF4 (# Int#
i#, PRS
k #) (# Int#
j#, PRS
m #) Char
c Array Int PRS
arr
  where
    !(I# Int#
i#, I# Int#
j#) = Array Int PRS -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int PRS
arr
    !k :: PRS
k = Array Int PRS -> Int -> PRS
forall i e. Array i e -> Int -> e
unsafeAt Array Int PRS
arr (Int# -> Int
I# Int#
i#)
    !m :: PRS
m = Array Int PRS -> Int -> PRS
forall i e. Array i e -> Int -> e
unsafeAt Array Int PRS
arr (Int# -> Int
I# Int#
i#)
{-# INLINE findC #-}

str2PRSs :: CharPhoneticClassification -> String -> StringRepresentation
str2PRSs :: Array Int PRS -> String -> [PRS]
str2PRSs Array Int PRS
arr = (Char -> PRS) -> String -> [PRS]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> Maybe PRS -> PRS
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PRS -> PRS)
-> (Array Int PRS -> Maybe PRS) -> Array Int PRS -> PRS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Array Int PRS -> Maybe PRS
findC Char
c (Array Int PRS -> PRS) -> Array Int PRS -> PRS
forall a b. (a -> b) -> a -> b
$ Array Int PRS
arr)
{-# INLINE str2PRSs #-}

{- | Function-predicate 'createsSyllable' checks whether its argument is a phoneme representation that
every time being presented in the text leads to the creation of the new syllable (in the 'PRS' format).
Usually it is a vowel, but in some languages there can be syllabic phonemes that are not considered to be
vowels.
-}
createsSyllable :: PRS -> Bool
createsSyllable :: PRS -> Bool
createsSyllable = (PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== Int8 -> PhoneticType
P Int8
0) (PhoneticType -> Bool) -> (PRS -> PhoneticType) -> PRS -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PRS -> PhoneticType
phoneType
{-# INLINE createsSyllable #-}

-- | Function-predicate 'isSonorous1' checks whether its argument is a sonorous consonant representation in the 'PRS' format.
isSonorous1 :: PRS -> Bool
isSonorous1 :: PRS -> Bool
isSonorous1 = (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` [Int
1, Int
2]) (Int -> Bool) -> (PRS -> Int) -> PRS -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticType -> Int
fromPhoneticType (PhoneticType -> Int) -> (PRS -> PhoneticType) -> PRS -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PRS -> PhoneticType
phoneType
{-# INLINE isSonorous1 #-}

-- | Function-predicate 'isVoicedC1' checks whether its argument is a voiced consonant representation in the 'PRS' format.
isVoicedC1 :: PRS -> Bool
isVoicedC1 :: PRS -> Bool
isVoicedC1 = (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` [Int
3, Int
4]) (Int -> Bool) -> (PRS -> Int) -> PRS -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticType -> Int
fromPhoneticType (PhoneticType -> Int) -> (PRS -> PhoneticType) -> PRS -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PRS -> PhoneticType
phoneType
{-# INLINE isVoicedC1 #-}

-- | Function-predicate 'isVoiceless1' checks whether its argument is a voiceless consonant representation in the 'PRS' format.
isVoicelessC1 :: PRS -> Bool
isVoicelessC1 :: PRS -> Bool
isVoicelessC1 = (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` [Int
5, Int
6]) (Int -> Bool) -> (PRS -> Int) -> PRS -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneticType -> Int
fromPhoneticType (PhoneticType -> Int) -> (PRS -> PhoneticType) -> PRS -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PRS -> PhoneticType
phoneType
{-# INLINE isVoicelessC1 #-}

-- | Binary function-predicate 'notCreatesSyllable2' checks whether its arguments are both consonant representations in the 'PRS' format.
notCreatesSyllable2 :: PRS -> PRS -> Bool
notCreatesSyllable2 :: PRS -> PRS -> Bool
notCreatesSyllable2 PRS
x PRS
y
    | PRS -> PhoneticType
phoneType PRS
x PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== Int8 -> PhoneticType
P Int8
0 Bool -> Bool -> Bool
|| PRS -> PhoneticType
phoneType PRS
y PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== Int8 -> PhoneticType
P Int8
0 = Bool
False
    | Bool
otherwise = Bool
True
{-# INLINE notCreatesSyllable2 #-}

-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).
notEqC ::
    -- | The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly.
    [(Char, Char)] ->
    PRS ->
    PRS ->
    Bool
notEqC :: [(Char, Char)] -> PRS -> PRS -> Bool
notEqC [(Char, Char)]
xs PRS
x PRS
y
    | (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
cy) (Char -> Bool) -> (Char -> Char) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [(Char, Char)] -> Char -> Char
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Char
cx [(Char, Char)]
xs (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Char
cx = Bool
False
    | Bool
otherwise = Char
cx Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
cy
  where
    !cx :: Char
cx = PRS -> Char
charS PRS
x
    !cy :: Char
cy = PRS -> Char
charS PRS
y
{-# INLINE notEqC #-}

{- | Function 'sndGroups' converts a word being a list of 'PRS' to the list of phonetically similar (consonants grouped with consonants and each vowel separately)
sounds representations in 'PRS' format.
-}
sndGroups :: [PRS] -> [[PRS]]
sndGroups :: [PRS] -> [[PRS]]
sndGroups ys :: [PRS]
ys@(PRS
_ : [PRS]
_) = (PRS -> PRS -> Bool) -> [PRS] -> [[PRS]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy PRS -> PRS -> Bool
notCreatesSyllable2 [PRS]
ys
sndGroups [PRS]
_ = []
{-# INLINE sndGroups #-}

groupSnds :: [PRS] -> [[PRS]]
groupSnds :: [PRS] -> [[PRS]]
groupSnds = (PRS -> PRS -> Bool) -> [PRS] -> [[PRS]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\PRS
x PRS
y -> PRS -> Bool
createsSyllable PRS
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== PRS -> Bool
createsSyllable PRS
y)
{-# INLINE groupSnds #-}

data SegmentationInfo1 = SI
    { SegmentationInfo1 -> Int8
fieldN :: !Int8
    -- ^ Number of fields in the pattern matching that are needed to apply the segmentation rules. Not less than 1.
    , SegmentationInfo1 -> Int8
predicateN :: Int8
    -- ^ Number of predicates in the definition for the 'fieldN' that are needed to apply the segmentation rules.
    }
    deriving (SegmentationInfo1 -> SegmentationInfo1 -> Bool
(SegmentationInfo1 -> SegmentationInfo1 -> Bool)
-> (SegmentationInfo1 -> SegmentationInfo1 -> Bool)
-> Eq SegmentationInfo1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SegmentationInfo1 -> SegmentationInfo1 -> Bool
== :: SegmentationInfo1 -> SegmentationInfo1 -> Bool
$c/= :: SegmentationInfo1 -> SegmentationInfo1 -> Bool
/= :: SegmentationInfo1 -> SegmentationInfo1 -> Bool
Eq, ReadPrec [SegmentationInfo1]
ReadPrec SegmentationInfo1
Int -> ReadS SegmentationInfo1
ReadS [SegmentationInfo1]
(Int -> ReadS SegmentationInfo1)
-> ReadS [SegmentationInfo1]
-> ReadPrec SegmentationInfo1
-> ReadPrec [SegmentationInfo1]
-> Read SegmentationInfo1
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SegmentationInfo1
readsPrec :: Int -> ReadS SegmentationInfo1
$creadList :: ReadS [SegmentationInfo1]
readList :: ReadS [SegmentationInfo1]
$creadPrec :: ReadPrec SegmentationInfo1
readPrec :: ReadPrec SegmentationInfo1
$creadListPrec :: ReadPrec [SegmentationInfo1]
readListPrec :: ReadPrec [SegmentationInfo1]
Read, Int -> SegmentationInfo1 -> ShowS
[SegmentationInfo1] -> ShowS
SegmentationInfo1 -> String
(Int -> SegmentationInfo1 -> ShowS)
-> (SegmentationInfo1 -> String)
-> ([SegmentationInfo1] -> ShowS)
-> Show SegmentationInfo1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SegmentationInfo1 -> ShowS
showsPrec :: Int -> SegmentationInfo1 -> ShowS
$cshow :: SegmentationInfo1 -> String
show :: SegmentationInfo1 -> String
$cshowList :: [SegmentationInfo1] -> ShowS
showList :: [SegmentationInfo1] -> ShowS
Show)

instance PhoneticElement SegmentationInfo1 where
    readPEMaybe :: String -> Maybe SegmentationInfo1
readPEMaybe String
rs
        | Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall a. (a -> Bool) -> [a] -> Bool
any Char -> Bool
isLetter (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
rs = Maybe SegmentationInfo1
forall a. Maybe a
Nothing
        | Bool
otherwise =
            let (String
ys : [String]
yss) = String -> [String]
L.words String
rs
             in case String
ys of
                    String
"SI" -> case [String]
yss of
                        [String
xs, String
ts] -> case (String -> Maybe Int8
forall a. Read a => String -> Maybe a
readMaybe String
xs :: Maybe Int8) of
                            Just Int8
m -> case (String -> Maybe Int8
forall a. Read a => String -> Maybe a
readMaybe String
ts :: Maybe Int8) of
                                Just Int8
n -> SegmentationInfo1 -> Maybe SegmentationInfo1
forall a. a -> Maybe a
Just (Int8 -> Int8 -> SegmentationInfo1
SI Int8
m Int8
n)
                                Maybe Int8
_ -> Maybe SegmentationInfo1
forall a. Maybe a
Nothing
                            Maybe Int8
_ -> Maybe SegmentationInfo1
forall a. Maybe a
Nothing
                        [String]
_ -> Maybe SegmentationInfo1
forall a. Maybe a
Nothing
                    String
_ -> Maybe SegmentationInfo1
forall a. Maybe a
Nothing

{- | We can think of 'SegmentationPredFunction' in terms of @f ('SI' fN pN) ks [x_{1},x_{2},...,x_{i},...,x_{fN}]@. Comparing with
'divCnsnts' from the @ukrainian-phonetics-basics-array@ we can postulate that it consists of the following logical terms in
the symbolic form:

1) 'phoneType' x_{i} \`'elem'\` (X{...} = 'map' 'P' ['Int8'])

2) 'notEqC' ks x_{i} x_{j} (j /= i)

combined with the standard logic Boolean operations of '(&&)', '(||)' and 'not'. Further, the 'not' can be transformed into the
positive (affirmative) form using the notion of the universal set for the task. This transformation needs that the similar
phonetic phenomenae (e. g. the double sounds -- the prolonged ones) belong to the one syllable and not to the different ones
(so they are not related to different syllables, but just to the one and the same). Since such assumption has been used,
we can further represent the function by the following data type and operations with it, see 'SegmentationPredFData'.
-}
data SegmentationPredFunction
    = PF (SegmentationInfo1 -> [(Char, Char)] -> [PRS] -> Bool)

data SegmentationPredFData a b
    = L Int [Int] (Array Int a)
    | NEC Int Int (Array Int a) [b]
    | C (SegmentationPredFData a b) (SegmentationPredFData a b)
    | D (SegmentationPredFData a b) (SegmentationPredFData a b)
    deriving (SegmentationPredFData a b -> SegmentationPredFData a b -> Bool
(SegmentationPredFData a b -> SegmentationPredFData a b -> Bool)
-> (SegmentationPredFData a b -> SegmentationPredFData a b -> Bool)
-> Eq (SegmentationPredFData a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
SegmentationPredFData a b -> SegmentationPredFData a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
SegmentationPredFData a b -> SegmentationPredFData a b -> Bool
== :: SegmentationPredFData a b -> SegmentationPredFData a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
SegmentationPredFData a b -> SegmentationPredFData a b -> Bool
/= :: SegmentationPredFData a b -> SegmentationPredFData a b -> Bool
Eq, ReadPrec [SegmentationPredFData a b]
ReadPrec (SegmentationPredFData a b)
Int -> ReadS (SegmentationPredFData a b)
ReadS [SegmentationPredFData a b]
(Int -> ReadS (SegmentationPredFData a b))
-> ReadS [SegmentationPredFData a b]
-> ReadPrec (SegmentationPredFData a b)
-> ReadPrec [SegmentationPredFData a b]
-> Read (SegmentationPredFData a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b.
(Read a, Read b) =>
ReadPrec [SegmentationPredFData a b]
forall a b.
(Read a, Read b) =>
ReadPrec (SegmentationPredFData a b)
forall a b.
(Read a, Read b) =>
Int -> ReadS (SegmentationPredFData a b)
forall a b. (Read a, Read b) => ReadS [SegmentationPredFData a b]
$creadsPrec :: forall a b.
(Read a, Read b) =>
Int -> ReadS (SegmentationPredFData a b)
readsPrec :: Int -> ReadS (SegmentationPredFData a b)
$creadList :: forall a b. (Read a, Read b) => ReadS [SegmentationPredFData a b]
readList :: ReadS [SegmentationPredFData a b]
$creadPrec :: forall a b.
(Read a, Read b) =>
ReadPrec (SegmentationPredFData a b)
readPrec :: ReadPrec (SegmentationPredFData a b)
$creadListPrec :: forall a b.
(Read a, Read b) =>
ReadPrec [SegmentationPredFData a b]
readListPrec :: ReadPrec [SegmentationPredFData a b]
Read, Int -> SegmentationPredFData a b -> ShowS
[SegmentationPredFData a b] -> ShowS
SegmentationPredFData a b -> String
(Int -> SegmentationPredFData a b -> ShowS)
-> (SegmentationPredFData a b -> String)
-> ([SegmentationPredFData a b] -> ShowS)
-> Show (SegmentationPredFData a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b.
(Show a, Show b) =>
Int -> SegmentationPredFData a b -> ShowS
forall a b.
(Show a, Show b) =>
[SegmentationPredFData a b] -> ShowS
forall a b. (Show a, Show b) => SegmentationPredFData a b -> String
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> SegmentationPredFData a b -> ShowS
showsPrec :: Int -> SegmentationPredFData a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => SegmentationPredFData a b -> String
show :: SegmentationPredFData a b -> String
$cshowList :: forall a b.
(Show a, Show b) =>
[SegmentationPredFData a b] -> ShowS
showList :: [SegmentationPredFData a b] -> ShowS
Show)

class Eval2Bool a where
    eval2Bool :: a -> Bool

type SegmentationFDP = SegmentationPredFData PRS (Char, Char)

instance Eval2Bool (SegmentationPredFData PRS (Char, Char)) where
    eval2Bool :: SegmentationPredFData PRS (Char, Char) -> Bool
eval2Bool (L Int
i [Int]
js Array Int PRS
arr)
        | (Int -> Bool) -> [Int] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) [Int]
js Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1) [Int]
js =
            PhoneticType -> Int
fromPhoneticType (PRS -> PhoneticType
phoneType (Array Int PRS -> Int -> PRS
forall i e. Array i e -> Int -> e
unsafeAt Array Int PRS
arr (Int -> PRS) -> Int -> PRS
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` [Int]
js
        | Bool
otherwise =
            String -> Bool
forall a. HasCallStack => String -> a
error
                String
"Aftovolio.General.Syllables.eval2Bool: 'L' element is not properly defined. "
      where
        n :: Int
n = Array Int PRS -> Int
forall i e. Array i e -> Int
numElements Array Int PRS
arr
    eval2Bool (NEC Int
i Int
j Array Int PRS
arr [(Char, Char)]
ks)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
j Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n =
            [(Char, Char)] -> PRS -> PRS -> Bool
notEqC [(Char, Char)]
ks (Array Int PRS -> Int -> PRS
forall i e. Array i e -> Int -> e
unsafeAt Array Int PRS
arr (Int -> PRS) -> Int -> PRS
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Array Int PRS -> Int -> PRS
forall i e. Array i e -> Int -> e
unsafeAt Array Int PRS
arr (Int -> PRS) -> Int -> PRS
forall a b. (a -> b) -> a -> b
$ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        | Bool
otherwise =
            String -> Bool
forall a. HasCallStack => String -> a
error
                String
"Aftovolio.General.Syllables.eval2Bool: 'NEC' element is not properly defined. "
      where
        n :: Int
n = Array Int PRS -> Int
forall i e. Array i e -> Int
numElements Array Int PRS
arr
    eval2Bool (C SegmentationPredFData PRS (Char, Char)
x SegmentationPredFData PRS (Char, Char)
y) = SegmentationPredFData PRS (Char, Char) -> Bool
forall a. Eval2Bool a => a -> Bool
eval2Bool SegmentationPredFData PRS (Char, Char)
x Bool -> Bool -> Bool
&& SegmentationPredFData PRS (Char, Char) -> Bool
forall a. Eval2Bool a => a -> Bool
eval2Bool SegmentationPredFData PRS (Char, Char)
y
    eval2Bool (D SegmentationPredFData PRS (Char, Char)
x SegmentationPredFData PRS (Char, Char)
y) = SegmentationPredFData PRS (Char, Char) -> Bool
forall a. Eval2Bool a => a -> Bool
eval2Bool SegmentationPredFData PRS (Char, Char)
x Bool -> Bool -> Bool
|| SegmentationPredFData PRS (Char, Char) -> Bool
forall a. Eval2Bool a => a -> Bool
eval2Bool SegmentationPredFData PRS (Char, Char)
y

type DListFunctionResult = ([PRS] -> [PRS], [PRS] -> [PRS])

class DListRepresentation a b where
    toDLR :: b -> [a] -> ([a] -> [a], [a] -> [a])

instance DListRepresentation PRS Int8 where
    toDLR :: Int8 -> [PRS] -> ([PRS] -> [PRS], [PRS] -> [PRS])
toDLR Int8
left [PRS]
xs
        | [PRS] -> Bool
forall a. [a] -> Bool
null [PRS]
xs = ([PRS] -> [PRS]
forall a. a -> a
id, [PRS] -> [PRS]
forall a. a -> a
id)
        | [PRS] -> Bool
forall a. [a] -> Bool
null [PRS]
ts = ([PRS] -> [PRS]
forall a. a -> a
id, ([PRS]
zs [PRS] -> [PRS] -> [PRS]
forall a. Monoid a => a -> a -> a
`mappend`))
        | [PRS] -> Bool
forall a. [a] -> Bool
null [PRS]
zs = (([PRS] -> [PRS] -> [PRS]
forall a. Monoid a => a -> a -> a
`mappend` [PRS]
ts), [PRS] -> [PRS]
forall a. a -> a
id)
        | Bool
otherwise = (([PRS] -> [PRS] -> [PRS]
forall a. Monoid a => a -> a -> a
`mappend` [PRS]
ts), ([PRS]
zs [PRS] -> [PRS] -> [PRS]
forall a. Monoid a => a -> a -> a
`mappend`))
      where
        ([PRS]
ts, [PRS]
zs) = Int -> [PRS] -> ([PRS], [PRS])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int8 -> Int
forall a. Enum a => a -> Int
fromEnum Int8
left) [PRS]
xs

data SegmentationLineFunction = LFS
    { SegmentationLineFunction -> SegmentationInfo1
infoSP :: SegmentationInfo1
    , SegmentationLineFunction -> SegmentationPredFData PRS (Char, Char)
predF :: SegmentationFDP
    -- ^ The predicate to check the needed rule for segmentation.
    , SegmentationLineFunction -> Int8
resF :: Int8
    -- ^ The result argument to be appended to the left of the group of consonants if the 'predF' returns 'True' for its arguments. Is an argument to the 'toDLR'.
    }
    deriving (ReadPrec [SegmentationLineFunction]
ReadPrec SegmentationLineFunction
Int -> ReadS SegmentationLineFunction
ReadS [SegmentationLineFunction]
(Int -> ReadS SegmentationLineFunction)
-> ReadS [SegmentationLineFunction]
-> ReadPrec SegmentationLineFunction
-> ReadPrec [SegmentationLineFunction]
-> Read SegmentationLineFunction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SegmentationLineFunction
readsPrec :: Int -> ReadS SegmentationLineFunction
$creadList :: ReadS [SegmentationLineFunction]
readList :: ReadS [SegmentationLineFunction]
$creadPrec :: ReadPrec SegmentationLineFunction
readPrec :: ReadPrec SegmentationLineFunction
$creadListPrec :: ReadPrec [SegmentationLineFunction]
readListPrec :: ReadPrec [SegmentationLineFunction]
Read, Int -> SegmentationLineFunction -> ShowS
[SegmentationLineFunction] -> ShowS
SegmentationLineFunction -> String
(Int -> SegmentationLineFunction -> ShowS)
-> (SegmentationLineFunction -> String)
-> ([SegmentationLineFunction] -> ShowS)
-> Show SegmentationLineFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SegmentationLineFunction -> ShowS
showsPrec :: Int -> SegmentationLineFunction -> ShowS
$cshow :: SegmentationLineFunction -> String
show :: SegmentationLineFunction -> String
$cshowList :: [SegmentationLineFunction] -> ShowS
showList :: [SegmentationLineFunction] -> ShowS
Show)

data SegmentationRules1 = SR1
    { SegmentationRules1 -> SegmentationInfo1
infoS :: SegmentationInfo1
    , SegmentationRules1 -> [SegmentationLineFunction]
lineFs :: [SegmentationLineFunction]
    -- ^ The list must be sorted in the appropriate order of the guards usage for the predicates.
    -- The length of the list must be equal to the ('fromEnum' . 'predicateN' . 'infoS') value.
    }
    deriving (ReadPrec [SegmentationRules1]
ReadPrec SegmentationRules1
Int -> ReadS SegmentationRules1
ReadS [SegmentationRules1]
(Int -> ReadS SegmentationRules1)
-> ReadS [SegmentationRules1]
-> ReadPrec SegmentationRules1
-> ReadPrec [SegmentationRules1]
-> Read SegmentationRules1
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SegmentationRules1
readsPrec :: Int -> ReadS SegmentationRules1
$creadList :: ReadS [SegmentationRules1]
readList :: ReadS [SegmentationRules1]
$creadPrec :: ReadPrec SegmentationRules1
readPrec :: ReadPrec SegmentationRules1
$creadListPrec :: ReadPrec [SegmentationRules1]
readListPrec :: ReadPrec [SegmentationRules1]
Read, Int -> SegmentationRules1 -> ShowS
[SegmentationRules1] -> ShowS
SegmentationRules1 -> String
(Int -> SegmentationRules1 -> ShowS)
-> (SegmentationRules1 -> String)
-> ([SegmentationRules1] -> ShowS)
-> Show SegmentationRules1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SegmentationRules1 -> ShowS
showsPrec :: Int -> SegmentationRules1 -> ShowS
$cshow :: SegmentationRules1 -> String
show :: SegmentationRules1 -> String
$cshowList :: [SegmentationRules1] -> ShowS
showList :: [SegmentationRules1] -> ShowS
Show)

{- | List of the 'SegmentationRules1' sorted in the descending order by the 'fieldN' 'SegmentationInfo1' data and where the
length of all the 'SegmentationPredFunction' lists of 'PRS' are equal to the 'fieldN' 'SegmentationInfo1' data by definition.
-}
type SegmentRulesG = [SegmentationRules1]

{- | Function 'divCnsnts' is used to divide groups of consonants into two-elements lists that later are made belonging to
different neighbour syllables if the group is between two vowels in a word. The group must be not empty, but this is not checked.
The example phonetical information for the proper performance in Ukrainian can be found from the:
https://msn.khnu.km.ua/pluginfile.php/302375/mod_resource/content/1/%D0%9B.3.%D0%86%D0%86.%20%D0%A1%D0%BA%D0%BB%D0%B0%D0%B4.%D0%9D%D0%B0%D0%B3%D0%BE%D0%BB%D0%BE%D1%81.pdf
The example of the 'divCnsnts' can be found at: https://hackage.haskell.org/package/ukrainian-phonetics-basic-array-0.1.2.0/docs/src/Languages.Phonetic.Ukrainian.Syllable.Arr.html#divCnsnts
-}
divCnsnts ::
    -- | The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly.
    [(Char, Char)] ->
    SegmentRulesG ->
    [PRS] ->
    DListFunctionResult
divCnsnts :: [(Char, Char)]
-> [SegmentationRules1]
-> [PRS]
-> ([PRS] -> [PRS], [PRS] -> [PRS])
divCnsnts [(Char, Char)]
ks [SegmentationRules1]
gs xs :: [PRS]
xs@(PRS
_ : [PRS]
_) = Int8 -> [PRS] -> ([PRS] -> [PRS], [PRS] -> [PRS])
forall a b.
DListRepresentation a b =>
b -> [a] -> ([a] -> [a], [a] -> [a])
toDLR Int8
left [PRS]
xs
  where
    !js :: SegmentationRules1
js = Maybe SegmentationRules1 -> SegmentationRules1
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SegmentationRules1 -> SegmentationRules1)
-> ([SegmentationRules1] -> Maybe SegmentationRules1)
-> [SegmentationRules1]
-> SegmentationRules1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SegmentationRules1 -> Bool)
-> [SegmentationRules1] -> Maybe SegmentationRules1
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [PRS] -> Int
forall a. [a] -> Int
length [PRS]
xs) (Int -> Bool)
-> (SegmentationRules1 -> Int) -> SegmentationRules1 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int
forall a. Enum a => a -> Int
fromEnum (Int8 -> Int)
-> (SegmentationRules1 -> Int8) -> SegmentationRules1 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegmentationInfo1 -> Int8
fieldN (SegmentationInfo1 -> Int8)
-> (SegmentationRules1 -> SegmentationInfo1)
-> SegmentationRules1
-> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegmentationRules1 -> SegmentationInfo1
infoS) ([SegmentationRules1] -> SegmentationRules1)
-> [SegmentationRules1] -> SegmentationRules1
forall a b. (a -> b) -> a -> b
$ [SegmentationRules1]
gs -- js :: SegmentationRules1
    !left :: Int8
left = SegmentationLineFunction -> Int8
resF (SegmentationLineFunction -> Int8)
-> (SegmentationRules1 -> SegmentationLineFunction)
-> SegmentationRules1
-> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SegmentationLineFunction -> SegmentationLineFunction
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SegmentationLineFunction -> SegmentationLineFunction)
-> (SegmentationRules1 -> Maybe SegmentationLineFunction)
-> SegmentationRules1
-> SegmentationLineFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SegmentationLineFunction -> Bool)
-> [SegmentationLineFunction] -> Maybe SegmentationLineFunction
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (SegmentationPredFData PRS (Char, Char) -> Bool
forall a. Eval2Bool a => a -> Bool
eval2Bool (SegmentationPredFData PRS (Char, Char) -> Bool)
-> (SegmentationLineFunction
    -> SegmentationPredFData PRS (Char, Char))
-> SegmentationLineFunction
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegmentationLineFunction -> SegmentationPredFData PRS (Char, Char)
predF) ([SegmentationLineFunction] -> Maybe SegmentationLineFunction)
-> (SegmentationRules1 -> [SegmentationLineFunction])
-> SegmentationRules1
-> Maybe SegmentationLineFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegmentationRules1 -> [SegmentationLineFunction]
lineFs (SegmentationRules1 -> Int8) -> SegmentationRules1 -> Int8
forall a b. (a -> b) -> a -> b
$ SegmentationRules1
js
divCnsnts [(Char, Char)]
_ [SegmentationRules1]
_ [] = ([PRS] -> [PRS]
forall a. a -> a
id, [PRS] -> [PRS]
forall a. a -> a
id)

reSyllableCntnts ::
    -- | The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly.
    [(Char, Char)] ->
    SegmentRulesG ->
    [[PRS]] ->
    [[PRS]]
reSyllableCntnts :: [(Char, Char)] -> [SegmentationRules1] -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks [SegmentationRules1]
gs ([PRS]
xs : [PRS]
ys : [PRS]
zs : [[PRS]]
xss)
    | (PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int8 -> PhoneticType
P Int8
0) (PhoneticType -> Bool) -> ([PRS] -> PhoneticType) -> [PRS] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PRS -> PhoneticType
phoneType (PRS -> PhoneticType) -> ([PRS] -> PRS) -> [PRS] -> PhoneticType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PRS] -> PRS
forall a. HasCallStack => [a] -> a
last ([PRS] -> Bool) -> [PRS] -> Bool
forall a b. (a -> b) -> a -> b
$ [PRS]
ys =
        ([PRS] -> [PRS], [PRS] -> [PRS]) -> [PRS] -> [PRS]
forall a b. (a, b) -> a
fst ([(Char, Char)]
-> [SegmentationRules1]
-> [PRS]
-> ([PRS] -> [PRS], [PRS] -> [PRS])
divCnsnts [(Char, Char)]
ks [SegmentationRules1]
gs [PRS]
ys) [PRS]
xs
            [PRS] -> [[PRS]] -> [[PRS]]
forall a. a -> [a] -> [a]
: [(Char, Char)] -> [SegmentationRules1] -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks [SegmentationRules1]
gs (([PRS] -> [PRS], [PRS] -> [PRS]) -> [PRS] -> [PRS]
forall a b. (a, b) -> b
snd ([(Char, Char)]
-> [SegmentationRules1]
-> [PRS]
-> ([PRS] -> [PRS], [PRS] -> [PRS])
divCnsnts [(Char, Char)]
ks [SegmentationRules1]
gs [PRS]
ys) [PRS]
zs [PRS] -> [[PRS]] -> [[PRS]]
forall a. a -> [a] -> [a]
: [[PRS]]
xss)
    | Bool
otherwise = [(Char, Char)] -> [SegmentationRules1] -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks [SegmentationRules1]
gs (([PRS]
xs [PRS] -> [PRS] -> [PRS]
forall a. Monoid a => a -> a -> a
`mappend` [PRS]
ys) [PRS] -> [[PRS]] -> [[PRS]]
forall a. a -> [a] -> [a]
: [PRS]
zs [PRS] -> [[PRS]] -> [[PRS]]
forall a. a -> [a] -> [a]
: [[PRS]]
xss)
reSyllableCntnts [(Char, Char)]
_ [SegmentationRules1]
_ ([PRS]
xs : [PRS]
ys : [[PRS]]
_) = [([PRS]
xs [PRS] -> [PRS] -> [PRS]
forall a. Monoid a => a -> a -> a
`mappend` [PRS]
ys)]
reSyllableCntnts [(Char, Char)]
_ [SegmentationRules1]
_ [[PRS]]
xss = [[PRS]]
xss

divSylls :: [[PRS]] -> [[PRS]]
divSylls :: [[PRS]] -> [[PRS]]
divSylls = ([PRS] -> Bool) -> ([PRS] -> [[PRS]]) -> [[PRS]] -> [[PRS]]
forall a. (a -> Bool) -> (a -> [a]) -> [a] -> [a]
mapI (\[PRS]
ws -> ([PRS] -> Int
forall a. [a] -> Int
length ([PRS] -> Int) -> ([PRS] -> [PRS]) -> [PRS] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRS -> Bool) -> [PRS] -> [PRS]
forall a. (a -> Bool) -> [a] -> [a]
filter PRS -> Bool
createsSyllable ([PRS] -> Int) -> [PRS] -> Int
forall a b. (a -> b) -> a -> b
$ [PRS]
ws) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) [PRS] -> [[PRS]]
h3
  where
    h3 :: [PRS] -> [[PRS]]
h3 [PRS]
us =
        [[PRS]
ys [PRS] -> [PRS] -> [PRS]
forall a. Monoid a => a -> a -> a
`mappend` Int -> [PRS] -> [PRS]
forall a. Int -> [a] -> [a]
take Int
1 [PRS]
zs]
            [[PRS]] -> [[PRS]] -> [[PRS]]
forall a. Monoid a => a -> a -> a
`mappend` ((PRS -> PRS -> Bool) -> [PRS] -> [[PRS]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\PRS
x PRS
y -> PRS -> Bool
createsSyllable PRS
x Bool -> Bool -> Bool
&& PRS -> PhoneticType
phoneType PRS
y PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int8 -> PhoneticType
P Int8
0) ([PRS] -> [[PRS]]) -> ([PRS] -> [PRS]) -> [PRS] -> [[PRS]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [PRS] -> [PRS]
forall a. Int -> [a] -> [a]
drop Int
1 ([PRS] -> [[PRS]]) -> [PRS] -> [[PRS]]
forall a b. (a -> b) -> a -> b
$ [PRS]
zs)
      where
        ([PRS]
ys, [PRS]
zs) = (PRS -> Bool) -> [PRS] -> ([PRS], [PRS])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break PRS -> Bool
createsSyllable [PRS]
us

{- | The function actually creates syllables using the provided data. Each resulting inner-most list is a phonetic language representation
of the syllable according to the rules provided.
-}
createSyllablesPL ::
    -- | Data used to obtain the phonetic language representation of the text.
    GWritingSystemPRPLX ->
    -- | The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly.
    [(Char, Char)] ->
    CharPhoneticClassification ->
    SegmentRulesG ->
    -- | Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
    String ->
    -- | Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
    String ->
    -- | Actually the converted 'String'.
    String ->
    [[[PRS]]]
createSyllablesPL :: GWritingSystemPRPLX
-> [(Char, Char)]
-> Array Int PRS
-> [SegmentationRules1]
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks Array Int PRS
arr [SegmentationRules1]
gs String
us String
vs =
    (String -> [[PRS]]) -> [String] -> [[[PRS]]]
forall a b. (a -> b) -> [a] -> [b]
map ([[PRS]] -> [[PRS]]
divSylls ([[PRS]] -> [[PRS]]) -> (String -> [[PRS]]) -> String -> [[PRS]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Char)] -> [SegmentationRules1] -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks [SegmentationRules1]
gs ([[PRS]] -> [[PRS]]) -> (String -> [[PRS]]) -> String -> [[PRS]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PRS] -> [[PRS]]
groupSnds ([PRS] -> [[PRS]]) -> (String -> [PRS]) -> String -> [[PRS]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int PRS -> String -> [PRS]
str2PRSs Array Int PRS
arr)
        ([String] -> [[[PRS]]])
-> (String -> [String]) -> String -> [[[PRS]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words1
        (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe Char) -> ShowS
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Char
g
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
convertToProperPL
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then Char
' ' else Char
x)
  where
    g :: Char -> Maybe Char
g Char
x
        | Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` String
us = Maybe Char
forall a. Maybe a
Nothing
        | Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
`notElem` String
vs = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
        | Bool
otherwise = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' '
    words1 :: String -> [String]
words1 String
xs = if String -> Bool
forall a. [a] -> Bool
null String
ts then [] else String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
words1 String
s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
      where
        ts :: String
ts = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
xs
        (String
w, String
s'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
ts
    {-# NOINLINE words1 #-}
    convertToProperPL :: ShowS
convertToProperPL = (PhoneticsRepresentationPLX -> String)
-> [PhoneticsRepresentationPLX] -> String
forall a b. (a -> [b]) -> [a] -> [b]
concatMap PhoneticsRepresentationPLX -> String
string1 ([PhoneticsRepresentationPLX] -> String)
-> (String -> [PhoneticsRepresentationPLX]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs
{-# INLINE createSyllablesPL #-}