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

-- |
-- 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(..)
  , DListFunctionResult
  , SegmentationLineFunction(..)
  , SegmentationRules1(..)
  , SegmentRulesG
  , DListRepresentation(..)
  -- * Basic functions
  , str2PRSs
  , sndGroups
  , groupSnds
  , divCnsnts
  , reSyllableCntnts
  , divVwls
  , createSyllablesPL
  -- * Auxiliary functions
  , gBF4
  , findC
  , isVowel1
  , isSonorous1
  , isVoicedC1
  , isVoicelessC1
  , isNotVowel2
  , notEqC
) 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.
} 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 )

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)

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

{-| 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 'isVowel1' checks whether its argument is a vowel representation in the 'PRS' format.
isVowel1 :: PRS -> Bool
isVowel1 :: PRS -> Bool
isVowel1 = (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 isVowel1 #-}

-- | 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 'isNotVowel2' checks whether its arguments are both consonant representations in the 'PRS' format.
isNotVowel2 :: PRS -> PRS -> Bool
isNotVowel2 :: PRS -> PRS -> Bool
isNotVowel2 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 isNotVowel2 #-}

-- | 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
isNotVowel2 [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 -> ((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 -> Bool) -> PRS -> Bool
forall a b. (a -> b) -> a -> b
$ PRS
x) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ((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 -> Bool) -> PRS -> Bool
forall a b. (a -> b) -> a -> b
$ 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)

instance Show SegmentationInfo1 where
  show :: SegmentationInfo1 -> String
show (SI Int8
m Int8
n) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
" " [String
"SI", Int8 -> String
forall a. Show a => a -> String
show Int8
m, Int8 -> String
forall a. Show a => a -> String
show Int8
n]

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

data SegmentationPredFunction = PF (SegmentationInfo1 -> [(Char, Char)] -> [PRS] -> Bool)

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 -> SegmentationPredFunction
predF :: SegmentationPredFunction,  -- ^ 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'.
}

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.
}  

{-| 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)] -> SegmentRulesG -> [PRS] -> DListFunctionResult
divCnsnts :: [(Char, Char)]
-> SegmentRulesG -> [PRS] -> ([PRS] -> [PRS], [PRS] -> [PRS])
divCnsnts [(Char, Char)]
ks SegmentRulesG
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)
-> (SegmentRulesG -> Maybe SegmentationRules1)
-> SegmentRulesG
-> SegmentationRules1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SegmentationRules1 -> Bool)
-> SegmentRulesG -> 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) (SegmentRulesG -> SegmentationRules1)
-> SegmentRulesG -> SegmentationRules1
forall a b. (a -> b) -> a -> b
$ SegmentRulesG
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 ((\(PF SegmentationInfo1 -> [(Char, Char)] -> [PRS] -> Bool
f) -> SegmentationInfo1 -> [(Char, Char)] -> [PRS] -> Bool
f (SegmentationRules1 -> SegmentationInfo1
infoS SegmentationRules1
js) [(Char, Char)]
ks [PRS]
xs) (SegmentationPredFunction -> Bool)
-> (SegmentationLineFunction -> SegmentationPredFunction)
-> SegmentationLineFunction
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegmentationLineFunction -> SegmentationPredFunction
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)]
_ SegmentRulesG
_ [] = ([PRS] -> [PRS]
forall a. a -> a
id,[PRS] -> [PRS]
forall a. a -> a
id)

reSyllableCntnts :: [(Char,Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]
reSyllableCntnts :: [(Char, Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
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)]
-> SegmentRulesG -> [PRS] -> ([PRS] -> [PRS], [PRS] -> [PRS])
divCnsnts [(Char, Char)]
ks SegmentRulesG
gs [PRS]
ys) [PRS]
xs[PRS] -> [[PRS]] -> [[PRS]]
forall a. a -> [a] -> [a]
:[(Char, Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
gs (([PRS] -> [PRS], [PRS] -> [PRS]) -> [PRS] -> [PRS]
forall a b. (a, b) -> b
snd ([(Char, Char)]
-> SegmentRulesG -> [PRS] -> ([PRS] -> [PRS], [PRS] -> [PRS])
divCnsnts [(Char, Char)]
ks SegmentRulesG
gs [PRS]
ys) [PRS]
zs[PRS] -> [[PRS]] -> [[PRS]]
forall a. a -> [a] -> [a]
:[[PRS]]
xss)
  | Bool
otherwise = [(Char, Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
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)]
_ SegmentRulesG
_ ([PRS]
xs:[PRS]
ys:[[PRS]]
_) = [([PRS]
xs [PRS] -> [PRS] -> [PRS]
forall a. Monoid a => a -> a -> a
`mappend` [PRS]
ys)]
reSyllableCntnts [(Char, Char)]
_ SegmentRulesG
_ [[PRS]]
xss = [[PRS]]
xss

divVwls :: [[PRS]] -> [[PRS]]
divVwls :: [[PRS]] -> [[PRS]]
divVwls = ([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 ((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] -> 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 -> 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) ([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])
span (\PRS
t -> PRS -> PhoneticType
phoneType PRS
t PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int8 -> PhoneticType
P Int8
0) [PRS]
us

createSyllablesPL
  :: GWritingSystemPRPLX
  -> [(Char,Char)]
  -> 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
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks Array Int PRS
arr SegmentRulesG
gs String
us String
vs = (String -> [[PRS]]) -> [String] -> [[[PRS]]]
forall a b. (a -> b) -> [a] -> [b]
map ([[PRS]] -> [[PRS]]
divVwls ([[PRS]] -> [[PRS]]) -> (String -> [[PRS]]) -> String -> [[PRS]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
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])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') String
ts
        {-# NOINLINE words1 #-}
        convertToProperPL :: ShowS
convertToProperPL = (PhoneticsRepresentationPLX -> Char)
-> [PhoneticsRepresentationPLX] -> String
forall a b. (a -> b) -> [a] -> [b]
map PhoneticsRepresentationPLX -> Char
char ([PhoneticsRepresentationPLX] -> String)
-> (String -> [PhoneticsRepresentationPLX]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs
{-# INLINE createSyllablesPL #-}