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

-- |
-- Module      :  Data.Phonetic.Languages.Syllables
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- This module works with syllable segmentation. The generalized version for the module
-- 'Languages.Phonetic.Ukrainian.Syllable.Arr' from @ukrainian-phonetics-basic-array@ package.
-- 

module Data.Phonetic.Languages.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 Prelude hiding (mappend)
import Data.Monoid
import qualified Data.List as L (groupBy,find,intercalate)
import Data.Phonetic.Languages.Base
import CaseBi.Arr
import GHC.Arr
import GHC.Exts
import Data.List.InnToOut.Basic (mapI)
import Data.Maybe (mapMaybe,fromJust)
import GHC.Int
import Text.Read (readMaybe)
import Data.Char (isLetter)

-- 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 :: !Char, -- ^ Phonetic languages phenomenon representation. Usually, a phoneme, but it can be otherwise something different.
  PRS -> PhoneticType
phoneType :: !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
/= :: PRS -> PRS -> Bool
$c/= :: PRS -> PRS -> Bool
== :: PRS -> PRS -> Bool
$c== :: 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
readListPrec :: ReadPrec [PRS]
$creadListPrec :: ReadPrec [PRS]
readPrec :: ReadPrec PRS
$creadPrec :: ReadPrec PRS
readList :: ReadS [PRS]
$creadList :: ReadS [PRS]
readsPrec :: Int -> ReadS PRS
$creadsPrec :: Int -> ReadS 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
cChar -> 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 !Int8 deriving (PhoneticType -> PhoneticType -> Bool
(PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> Bool) -> Eq PhoneticType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhoneticType -> PhoneticType -> Bool
$c/= :: PhoneticType -> PhoneticType -> Bool
== :: PhoneticType -> PhoneticType -> Bool
$c== :: 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
min :: PhoneticType -> PhoneticType -> PhoneticType
$cmin :: PhoneticType -> PhoneticType -> PhoneticType
max :: PhoneticType -> PhoneticType -> PhoneticType
$cmax :: PhoneticType -> PhoneticType -> PhoneticType
>= :: PhoneticType -> PhoneticType -> Bool
$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
compare :: PhoneticType -> PhoneticType -> Ordering
$ccompare :: PhoneticType -> PhoneticType -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [PhoneticType]
$creadListPrec :: ReadPrec [PhoneticType]
readPrec :: ReadPrec PhoneticType
$creadPrec :: ReadPrec PhoneticType
readList :: ReadS [PhoneticType]
$creadList :: ReadS [PhoneticType]
readsPrec :: Int -> ReadS PhoneticType
$creadsPrec :: Int -> ReadS PhoneticType
Read)

instance Show PhoneticType where
  show :: PhoneticType -> String
show (P Int8
x) = String
"P " String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` 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 :: (# 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#)
{-# INLINABLE gBF4 #-}

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

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)
  
-- | 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 =  (PhoneticType -> [PhoneticType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int8 -> PhoneticType
P Int8
1,Int8 -> PhoneticType
P Int8
2]) (PhoneticType -> Bool) -> (PRS -> PhoneticType) -> PRS -> Bool
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 = (PhoneticType -> [PhoneticType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int8 -> PhoneticType
P Int8
3,Int8 -> PhoneticType
P Int8
4]) (PhoneticType -> Bool) -> (PRS -> PhoneticType) -> PRS -> Bool
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 =  (PhoneticType -> [PhoneticType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int8 -> PhoneticType
P Int8
5,Int8 -> PhoneticType
P Int8
6]) (PhoneticType -> Bool) -> (PRS -> PhoneticType) -> PRS -> Bool
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
 :: [(Char,Char)] -- ^ 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. 
 -> 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

-- | 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]
_ = []

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)

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
/= :: SegmentationInfo1 -> SegmentationInfo1 -> Bool
$c/= :: SegmentationInfo1 -> SegmentationInfo1 -> Bool
== :: SegmentationInfo1 -> SegmentationInfo1 -> Bool
$c== :: 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
readListPrec :: ReadPrec [SegmentationInfo1]
$creadListPrec :: ReadPrec [SegmentationInfo1]
readPrec :: ReadPrec SegmentationInfo1
$creadPrec :: ReadPrec SegmentationInfo1
readList :: ReadS [SegmentationInfo1]
$creadList :: ReadS [SegmentationInfo1]
readsPrec :: Int -> ReadS SegmentationInfo1
$creadsPrec :: Int -> ReadS 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
showList :: [SegmentationInfo1] -> ShowS
$cshowList :: [SegmentationInfo1] -> ShowS
show :: SegmentationInfo1 -> String
$cshow :: SegmentationInfo1 -> String
showsPrec :: Int -> SegmentationInfo1 -> ShowS
$cshowsPrec :: Int -> 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 (t :: * -> *) a. Foldable t => (a -> Bool) -> t 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]
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
/= :: 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
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]
readListPrec :: ReadPrec [SegmentationPredFData a b]
$creadListPrec :: forall a b.
(Read a, Read b) =>
ReadPrec [SegmentationPredFData a b]
readPrec :: ReadPrec (SegmentationPredFData a b)
$creadPrec :: forall a b.
(Read a, Read b) =>
ReadPrec (SegmentationPredFData a b)
readList :: ReadS [SegmentationPredFData a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [SegmentationPredFData a b]
readsPrec :: Int -> ReadS (SegmentationPredFData a b)
$creadsPrec :: forall a b.
(Read a, Read b) =>
Int -> ReadS (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
showList :: [SegmentationPredFData a b] -> ShowS
$cshowList :: forall a b.
(Show a, Show b) =>
[SegmentationPredFData a b] -> ShowS
show :: SegmentationPredFData a b -> String
$cshow :: forall a b. (Show a, Show b) => SegmentationPredFData a b -> String
showsPrec :: Int -> SegmentationPredFData a b -> ShowS
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> 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 (t :: * -> *) a. Foldable t => (a -> Bool) -> t 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 (t :: * -> *) a. Foldable t => (a -> Bool) -> t 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
js
    | Bool
otherwise = String -> Bool
forall a. HasCallStack => String -> a
error String
"Data.Phonetic.Languages.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
"Data.Phonetic.Languages.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 (t :: * -> *) a. Foldable t => t a -> Bool
null [PRS]
xs = ([PRS] -> [PRS]
forall a. a -> a
id,[PRS] -> [PRS]
forall a. a -> a
id)
    | [PRS] -> Bool
forall (t :: * -> *) a. Foldable t => t 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 (t :: * -> *) a. Foldable t => t 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
readListPrec :: ReadPrec [SegmentationLineFunction]
$creadListPrec :: ReadPrec [SegmentationLineFunction]
readPrec :: ReadPrec SegmentationLineFunction
$creadPrec :: ReadPrec SegmentationLineFunction
readList :: ReadS [SegmentationLineFunction]
$creadList :: ReadS [SegmentationLineFunction]
readsPrec :: Int -> ReadS SegmentationLineFunction
$creadsPrec :: Int -> ReadS 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
showList :: [SegmentationLineFunction] -> ShowS
$cshowList :: [SegmentationLineFunction] -> ShowS
show :: SegmentationLineFunction -> String
$cshow :: SegmentationLineFunction -> String
showsPrec :: Int -> SegmentationLineFunction -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [SegmentationRules1]
$creadListPrec :: ReadPrec [SegmentationRules1]
readPrec :: ReadPrec SegmentationRules1
$creadPrec :: ReadPrec SegmentationRules1
readList :: ReadS [SegmentationRules1]
$creadList :: ReadS [SegmentationRules1]
readsPrec :: Int -> ReadS SegmentationRules1
$creadsPrec :: Int -> ReadS 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
showList :: [SegmentationRules1] -> ShowS
$cshowList :: [SegmentationRules1] -> ShowS
show :: SegmentationRules1 -> String
$cshow :: SegmentationRules1 -> String
showsPrec :: Int -> SegmentationRules1 -> ShowS
$cshowsPrec :: Int -> 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
 :: [(Char,Char)] -- ^ 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. 
 -> 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 (t :: * -> *) a. Foldable t => t 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
 :: [(Char,Char)] -- ^ 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. 
 -> 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. [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 (t :: * -> *) a. Foldable t => t 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
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ 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. 
  -> CharPhoneticClassification
  -> SegmentRulesG
  -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Actually the converted '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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
us = Maybe Char
forall a. Maybe a
Nothing
          | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t 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 (t :: * -> *) a. Foldable t => t 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 (t :: * -> *) a b. Foldable t => (a -> [b]) -> t 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 #-}