{-# 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
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]
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 forall a. Ord a => a -> a -> Ordering
compare Char
x1 Char
x2 of
      Ordering
EQ -> 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 \'" forall a. Monoid a => a -> a -> a
`mappend` (Char
cforall a. a -> [a] -> [a]
:Char
'\''forall a. a -> [a] -> [a]
:Char
' 'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int8
x)

data PhoneticType = P !Int8 deriving (PhoneticType -> PhoneticType -> Bool
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
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
Ord, ReadPrec [PhoneticType]
ReadPrec PhoneticType
Int -> ReadS PhoneticType
ReadS [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 " forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show Int8
x

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

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

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

-- | Is somewhat rewritten from the 'CaseBi.Arr.gBF3' function (not exported) from the @mmsyn2-array@ package.
gBF4
  :: (Ix i) => (# Int#, PRS #)
  -> (# Int#, PRS #)
  -> Char
  -> Array i PRS
  -> Maybe PRS
gBF4 :: forall i.
Ix i =>
(# Int#, PRS #)
-> (# Int#, PRS #) -> Char -> Array i PRS -> Maybe PRS
gBF4 (# !Int#
i#, PRS
k #) (# !Int#
j#, PRS
m #) Char
c Array i PRS
arr
 | Int# -> Bool
isTrue# ((Int#
j# Int# -> Int# -> Int#
-# Int#
i#) Int# -> Int# -> Int#
># Int#
1# ) = 
    case forall a. Ord a => a -> a -> Ordering
compare Char
c (PRS -> Char
charS PRS
p) of
     Ordering
GT -> 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  -> 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
_ -> forall a. a -> Maybe a
Just PRS
p
 | Char
c forall a. Eq a => a -> a -> Bool
== PRS -> Char
charS PRS
m = forall a. a -> Maybe a
Just PRS
m
 | Char
c forall a. Eq a => a -> a -> Bool
== PRS -> Char
charS PRS
k = forall a. a -> Maybe a
Just PRS
k
 | Bool
otherwise = 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 = 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 = 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#) = forall i e. Array i e -> (i, i)
bounds Array Int PRS
arr
           !k :: PRS
k = forall i e. Array i e -> Int -> e
unsafeAt Array Int PRS
arr (Int# -> Int
I# Int#
i#)
           !m :: PRS
m = 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 = forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Array Int PRS -> Maybe PRS
findC Char
c 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 = (forall a. Eq a => a -> a -> Bool
== Int8 -> PhoneticType
P Int8
0) 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 =  (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int8 -> PhoneticType
P Int8
1,Int8 -> PhoneticType
P Int8
2]) 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 = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int8 -> PhoneticType
P Int8
3,Int8 -> PhoneticType
P Int8
4]) 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 =  (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int8 -> PhoneticType
P Int8
5,Int8 -> PhoneticType
P Int8
6]) 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 forall a. Eq a => a -> a -> Bool
== Int8 -> PhoneticType
P Int8
0 Bool -> Bool -> Bool
|| PRS -> PhoneticType
phoneType PRS
y 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
  | (forall a. Eq a => a -> a -> Bool
== Char
cy) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Char
cx [(Char, Char)]
xs forall a b. (a -> b) -> a -> b
$ Char
cx = Bool
False
  | Bool
otherwise = Char
cx 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]
_) = forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy PRS -> PRS -> Bool
notCreatesSyllable2 [PRS]
ys
sndGroups [PRS]
_ = []

groupSnds :: [PRS] -> [[PRS]]
groupSnds :: [PRS] -> [[PRS]]
groupSnds = forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\PRS
x PRS
y -> PRS -> Bool
createsSyllable PRS
x 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
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]
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
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isLetter forall a b. (a -> b) -> a -> b
$ String
rs = 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 (forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int8) of
               Just Int8
m -> case (forall a. Read a => String -> Maybe a
readMaybe String
ts::Maybe Int8) of
                 Just Int8
n -> forall a. a -> Maybe a
Just (Int8 -> Int8 -> SegmentationInfo1
SI Int8
m Int8
n)
                 Maybe Int8
_ -> forall a. Maybe a
Nothing
               Maybe Int8
_ -> forall a. Maybe a
Nothing
           [String]
_ -> forall a. Maybe a
Nothing
        String
_ -> 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
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)
ReadS [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
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)
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> Bool
<= Int
n) [Int]
js Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> Bool
>=Int
1) [Int]
js = PhoneticType -> Int
fromPhoneticType (PRS -> PhoneticType
phoneType (forall i e. Array i e -> Int -> e
unsafeAt Array Int PRS
arr forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
- Int
1)) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
js
    | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Data.Phonetic.Languages.Syllables.eval2Bool: 'L' element is not properly defined. "
        where n :: Int
n = 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 forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
j forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i forall a. Eq a => a -> a -> Bool
/= Int
j Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
j forall a. Ord a => a -> a -> Bool
<= Int
n = [(Char, Char)] -> PRS -> PRS -> Bool
notEqC [(Char, Char)]
ks (forall i e. Array i e -> Int -> e
unsafeAt Array Int PRS
arr forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
- Int
1) (forall i e. Array i e -> Int -> e
unsafeAt Array Int PRS
arr forall a b. (a -> b) -> a -> b
$ Int
j forall a. Num a => a -> a -> a
- Int
1)
    | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Data.Phonetic.Languages.Syllables.eval2Bool: 'NEC' element is not properly defined. "
        where n :: Int
n = forall i e. Array i e -> Int
numElements Array Int PRS
arr
  eval2Bool (C SegmentationPredFData PRS (Char, Char)
x SegmentationPredFData PRS (Char, Char)
y) = forall a. Eval2Bool a => a -> Bool
eval2Bool SegmentationPredFData PRS (Char, Char)
x Bool -> Bool -> 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) = forall a. Eval2Bool a => a -> Bool
eval2Bool SegmentationPredFData PRS (Char, Char)
x Bool -> Bool -> 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
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PRS]
xs = (forall a. a -> a
id,forall a. a -> a
id)
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PRS]
ts =  (forall a. a -> a
id,([PRS]
zs forall a. Monoid a => a -> a -> a
`mappend`))
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PRS]
zs = ((forall a. Monoid a => a -> a -> a
`mappend` [PRS]
ts), forall a. a -> a
id)
    | Bool
otherwise = ((forall a. Monoid a => a -> a -> a
`mappend` [PRS]
ts), ([PRS]
zs forall a. Monoid a => a -> a -> a
`mappend`))
        where ([PRS]
ts,[PRS]
zs) = forall a. Int -> [a] -> ([a], [a])
splitAt (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]
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
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]
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
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]
_) = forall a b.
DListRepresentation a b =>
b -> [a] -> ([a] -> [a], [a] -> [a])
toDLR Int8
left [PRS]
xs
  where !js :: SegmentationRules1
js = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [PRS]
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegmentationInfo1 -> Int8
fieldN forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegmentationRules1 -> SegmentationInfo1
infoS) forall a b. (a -> b) -> a -> b
$ [SegmentationRules1]
gs -- js :: SegmentationRules1
        !left :: Int8
left = SegmentationLineFunction -> Int8
resF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eval2Bool a => a -> Bool
eval2Bool forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegmentationLineFunction -> SegmentationPredFData PRS (Char, Char)
predF)forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegmentationRules1 -> [SegmentationLineFunction]
lineFs forall a b. (a -> b) -> a -> b
$ SegmentationRules1
js
divCnsnts [(Char, Char)]
_ [SegmentationRules1]
_ [] = (forall a. a -> a
id,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)
  | (forall a. Eq a => a -> a -> Bool
/= Int8 -> PhoneticType
P Int8
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PRS -> PhoneticType
phoneType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ [PRS]
ys = forall a b. (a, b) -> a
fst ([(Char, Char)]
-> [SegmentationRules1]
-> [PRS]
-> ([PRS] -> [PRS], [PRS] -> [PRS])
divCnsnts [(Char, Char)]
ks [SegmentationRules1]
gs [PRS]
ys) [PRS]
xsforall a. a -> [a] -> [a]
:[(Char, Char)] -> [SegmentationRules1] -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks [SegmentationRules1]
gs (forall a b. (a, b) -> b
snd ([(Char, Char)]
-> [SegmentationRules1]
-> [PRS]
-> ([PRS] -> [PRS], [PRS] -> [PRS])
divCnsnts [(Char, Char)]
ks [SegmentationRules1]
gs [PRS]
ys) [PRS]
zsforall a. a -> [a] -> [a]
:[[PRS]]
xss)
  | Bool
otherwise = [(Char, Char)] -> [SegmentationRules1] -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks [SegmentationRules1]
gs (([PRS]
xs forall a. Monoid a => a -> a -> a
`mappend` [PRS]
ys)forall a. a -> [a] -> [a]
:[PRS]
zsforall a. a -> [a] -> [a]
:[[PRS]]
xss)
reSyllableCntnts [(Char, Char)]
_ [SegmentationRules1]
_ ([PRS]
xs:[PRS]
ys:[[PRS]]
_) = [([PRS]
xs 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 = forall a. (a -> Bool) -> (a -> [a]) -> [a] -> [a]
mapI (\[PRS]
ws -> (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter PRS -> Bool
createsSyllable forall a b. (a -> b) -> a -> b
$ [PRS]
ws) forall a. Ord a => a -> a -> Bool
> Int
1) [PRS] -> [[PRS]]
h3
  where h3 :: [PRS] -> [[PRS]]
h3 [PRS]
us = [[PRS]
ys forall a. Monoid a => a -> a -> a
`mappend` forall a. Int -> [a] -> [a]
take Int
1 [PRS]
zs] forall a. Monoid a => a -> a -> a
`mappend` (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 forall a. Eq a => a -> a -> Bool
/= Int8 -> PhoneticType
P Int8
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ [PRS]
zs)
                  where ([PRS]
ys,[PRS]
zs) = 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 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Actually the converted 'String'.
  -> [[[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 = forall a b. (a -> b) -> [a] -> [b]
map ([[PRS]] -> [[PRS]]
divSylls forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Char)] -> [SegmentationRules1] -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks [SegmentationRules1]
gs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PRS] -> [[PRS]]
groupSnds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int PRS -> String -> [PRS]
str2PRSs Array Int PRS
arr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Char
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
convertToProperPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x forall a. Eq a => a -> a -> Bool
== Char
'-' then Char
' ' else Char
x)
  where g :: Char -> Maybe Char
g Char
x
          | Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
us = forall a. Maybe a
Nothing
          | Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
vs = forall a. a -> Maybe a
Just Char
x
          | Bool
otherwise = forall a. a -> Maybe a
Just Char
' '
        words1 :: String -> [String]
words1 String
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ts then [] else String
w 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 = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') String
xs
                (String
w, String
s'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
' ') String
ts
        {-# NOINLINE words1 #-}
        convertToProperPL :: ShowS
convertToProperPL = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PhoneticsRepresentationPLX -> String
string1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs
{-# INLINE createSyllablesPL #-}