{-# OPTIONS_HADDOCK show-extensions #-}
{-# OPTIONS_GHC -funbox-strict-fields -fobject-code #-}
{-# LANGUAGE BangPatterns #-}
{-# 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
  -- * 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)
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

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

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)

{-| 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 -> StringRepresentation
str2PRSs Array Int PRS
arr = (Char -> PRS) -> String -> StringRepresentation
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 :: StringRepresentation -> [StringRepresentation]
sndGroups ys :: StringRepresentation
ys@(PRS
_:StringRepresentation
_) = (PRS -> PRS -> Bool)
-> StringRepresentation -> [StringRepresentation]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy PRS -> PRS -> Bool
isNotVowel2 StringRepresentation
ys
sndGroups StringRepresentation
_ = []

groupSnds :: [PRS] -> [[PRS]]
groupSnds :: StringRepresentation -> [StringRepresentation]
groupSnds = (PRS -> PRS -> Bool)
-> StringRepresentation -> [StringRepresentation]
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)

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

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

data SegmentationLineFunction = LFS {
  SegmentationLineFunction -> SegmentationPredFunction
predF :: SegmentationPredFunction,  -- ^ The predicate to check the needed rule for segmentation.
  SegmentationLineFunction -> DListFunctionResult
resF :: DListFunctionResult -- ^ The result if the 'predF' returns 'True' for its arguments.
}

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 -> StringRepresentation -> DListFunctionResult
divCnsnts [(Char, Char)]
ks SegmentRulesG
gs xs :: StringRepresentation
xs@(PRS
_:StringRepresentation
_) = SegmentationLineFunction -> DListFunctionResult
resF (SegmentationLineFunction -> DListFunctionResult)
-> (SegmentationRules1 -> SegmentationLineFunction)
-> SegmentationRules1
-> DListFunctionResult
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)] -> StringRepresentation -> Bool
f) -> SegmentationInfo1 -> [(Char, Char)] -> StringRepresentation -> Bool
f (SegmentationRules1 -> SegmentationInfo1
infoS SegmentationRules1
js) [(Char, Char)]
ks StringRepresentation
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 -> DListFunctionResult)
-> SegmentationRules1 -> DListFunctionResult
forall a b. (a -> b) -> a -> b
$ SegmentationRules1
js
  where !l :: Int
l = StringRepresentation -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length StringRepresentation
xs
        !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
== Int
l) (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
divCnsnts [(Char, Char)]
_ SegmentRulesG
_ [] = (StringRepresentation -> StringRepresentation
forall a. a -> a
id,StringRepresentation -> StringRepresentation
forall a. a -> a
id)

reSyllableCntnts :: [(Char,Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]
reSyllableCntnts :: [(Char, Char)]
-> SegmentRulesG
-> [StringRepresentation]
-> [StringRepresentation]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
gs (StringRepresentation
xs:StringRepresentation
ys:StringRepresentation
zs:[StringRepresentation]
xss)
  | (PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int8 -> PhoneticType
P Int8
0) (PhoneticType -> Bool)
-> (StringRepresentation -> PhoneticType)
-> StringRepresentation
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PRS -> PhoneticType
phoneType (PRS -> PhoneticType)
-> (StringRepresentation -> PRS)
-> StringRepresentation
-> PhoneticType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringRepresentation -> PRS
forall a. [a] -> a
last (StringRepresentation -> Bool) -> StringRepresentation -> Bool
forall a b. (a -> b) -> a -> b
$ StringRepresentation
ys = DListFunctionResult -> StringRepresentation -> StringRepresentation
forall a b. (a, b) -> a
fst ([(Char, Char)]
-> SegmentRulesG -> StringRepresentation -> DListFunctionResult
divCnsnts [(Char, Char)]
ks SegmentRulesG
gs StringRepresentation
ys) StringRepresentation
xsStringRepresentation
-> [StringRepresentation] -> [StringRepresentation]
forall a. a -> [a] -> [a]
:[(Char, Char)]
-> SegmentRulesG
-> [StringRepresentation]
-> [StringRepresentation]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
gs (DListFunctionResult -> StringRepresentation -> StringRepresentation
forall a b. (a, b) -> b
snd ([(Char, Char)]
-> SegmentRulesG -> StringRepresentation -> DListFunctionResult
divCnsnts [(Char, Char)]
ks SegmentRulesG
gs StringRepresentation
ys) StringRepresentation
zsStringRepresentation
-> [StringRepresentation] -> [StringRepresentation]
forall a. a -> [a] -> [a]
:[StringRepresentation]
xss)
  | Bool
otherwise = [(Char, Char)]
-> SegmentRulesG
-> [StringRepresentation]
-> [StringRepresentation]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
gs ((StringRepresentation
xs StringRepresentation
-> StringRepresentation -> StringRepresentation
forall a. Monoid a => a -> a -> a
`mappend` StringRepresentation
ys)StringRepresentation
-> [StringRepresentation] -> [StringRepresentation]
forall a. a -> [a] -> [a]
:StringRepresentation
zsStringRepresentation
-> [StringRepresentation] -> [StringRepresentation]
forall a. a -> [a] -> [a]
:[StringRepresentation]
xss)
reSyllableCntnts [(Char, Char)]
_ SegmentRulesG
_ (StringRepresentation
xs:StringRepresentation
ys:[StringRepresentation]
_) = [(StringRepresentation
xs StringRepresentation
-> StringRepresentation -> StringRepresentation
forall a. Monoid a => a -> a -> a
`mappend` StringRepresentation
ys)]
reSyllableCntnts [(Char, Char)]
_ SegmentRulesG
_ [StringRepresentation]
xss = [StringRepresentation]
xss

divVwls :: [[PRS]] -> [[PRS]]
divVwls :: [StringRepresentation] -> [StringRepresentation]
divVwls = (StringRepresentation -> Bool)
-> (StringRepresentation -> [StringRepresentation])
-> [StringRepresentation]
-> [StringRepresentation]
forall a. (a -> Bool) -> (a -> [a]) -> [a] -> [a]
mapI (\StringRepresentation
ws -> (StringRepresentation -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (StringRepresentation -> Int)
-> (StringRepresentation -> StringRepresentation)
-> StringRepresentation
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRS -> Bool) -> StringRepresentation -> StringRepresentation
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) (StringRepresentation -> Int) -> StringRepresentation -> Int
forall a b. (a -> b) -> a -> b
$ StringRepresentation
ws) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) StringRepresentation -> [StringRepresentation]
h3
  where h3 :: StringRepresentation -> [StringRepresentation]
h3 StringRepresentation
us = [StringRepresentation
ys StringRepresentation
-> StringRepresentation -> StringRepresentation
forall a. Monoid a => a -> a -> a
`mappend` Int -> StringRepresentation -> StringRepresentation
forall a. Int -> [a] -> [a]
take Int
1 StringRepresentation
zs] [StringRepresentation]
-> [StringRepresentation] -> [StringRepresentation]
forall a. Monoid a => a -> a -> a
`mappend` ((PRS -> PRS -> Bool)
-> StringRepresentation -> [StringRepresentation]
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) (StringRepresentation -> [StringRepresentation])
-> (StringRepresentation -> StringRepresentation)
-> StringRepresentation
-> [StringRepresentation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StringRepresentation -> StringRepresentation
forall a. Int -> [a] -> [a]
drop Int
1 (StringRepresentation -> [StringRepresentation])
-> StringRepresentation -> [StringRepresentation]
forall a b. (a -> b) -> a -> b
$ StringRepresentation
zs)
                  where (StringRepresentation
ys,StringRepresentation
zs) = (PRS -> Bool)
-> StringRepresentation
-> (StringRepresentation, StringRepresentation)
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) StringRepresentation
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
-> [[StringRepresentation]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks Array Int PRS
arr SegmentRulesG
gs String
us String
vs = (String -> [StringRepresentation])
-> [String] -> [[StringRepresentation]]
forall a b. (a -> b) -> [a] -> [b]
map ([StringRepresentation] -> [StringRepresentation]
divVwls ([StringRepresentation] -> [StringRepresentation])
-> (String -> [StringRepresentation])
-> String
-> [StringRepresentation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Char)]
-> SegmentRulesG
-> [StringRepresentation]
-> [StringRepresentation]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
gs ([StringRepresentation] -> [StringRepresentation])
-> (String -> [StringRepresentation])
-> String
-> [StringRepresentation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringRepresentation -> [StringRepresentation]
groupSnds (StringRepresentation -> [StringRepresentation])
-> (String -> StringRepresentation)
-> String
-> [StringRepresentation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int PRS -> String -> StringRepresentation
str2PRSs Array Int PRS
arr) ([String] -> [[StringRepresentation]])
-> (String -> [String]) -> String -> [[StringRepresentation]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words1 (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe Char) -> String -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Char
g (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
convertToProperPL (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
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) -> String -> String
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 :: String -> String
convertToProperPL = (PhoneticsRepresentationPLX -> Char)
-> [PhoneticsRepresentationPLX] -> String
forall a b. (a -> b) -> [a] -> [b]
map PhoneticsRepresentationPLX -> Char
char ([PhoneticsRepresentationPLX] -> String)
-> (String -> [PhoneticsRepresentationPLX]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs
{-# INLINE createSyllablesPL #-}