{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phladiprelio.General.PropertiesFuncRepG2
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Generalization of the functionality of the DobutokO.Poetry.Norms
-- and DobutokO.Poetry.Norms.Extended modules
-- from the @dobutokO-poetry@ package and the recent module Phladiprelio.General.PropertiesFuncRepG2
-- from the @phonetic-languages-simplified-properties-array@. If you import the module with the last one
-- module, please, use the qualified import, because of common names.
--
-- Instead of vectors, uses arrays.

{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}

module Phladiprelio.General.PropertiesFuncRepG2 (
  -- * Functions with 'Int16'
  procDiverse2I
  -- * Functions with 'Double'
  , procB2FG
  , procB2F
  , procB2FF
  , procB2InvFG
  , procB2InvF
  , procB2InvFF
  , procRhythm23F
  , procDiverse2F
  -- * Working with rhythmicity
  , procRhythmicity23F
) where

import GHC.Base
import GHC.Int
import GHC.List
import GHC.Enum (fromEnum)
import GHC.Num ((+),(-),(*))
import GHC.Float ((**),int2Double)
import GHC.Real ((/))
import Phladiprelio.General.PropertiesSyllablesG2
import Phladiprelio.UniquenessPeriodsG
import Phladiprelio.Rhythmicity.Simple
import Phladiprelio.Rhythmicity.Factor
import Phladiprelio.Basis
import Phladiprelio.General.Base
import Phladiprelio.General.Syllables hiding (D)
import Data.Maybe (fromMaybe,mapMaybe)
import Phladiprelio.General.EmphasisG
import Phladiprelio.Coeffs

procDiverse2I
  :: (Ord c) => GWritingSystemPRPLX
  -> String -- ^ Actually is the \' \':us ++ vs in the following functions where in the definition is us and vs 'String's. See the
  -- source code of the module.
  -> (Int16 -> c)
  -> String -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Int16 c
procDiverse2I wrs zs g sels = 
  D (\x -> case x of
             StrG xs -> diverse2GGL sels zs . concatMap string1 . stringToXG wrs $ xs
             FSLG tsss -> 1) g
{-# INLINE procDiverse2I #-}

procDiverse2F
  :: (Ord c) => GWritingSystemPRPLX
  -> String -- ^ Actually is the \' \':us ++ vs in the following functions where in the definition is us and vs 'String's. See the
  -- source code of the module.
  -> (Double -> c)
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procDiverse2F wrs zs g sels = 
  D (\x ->case x of
           StrG xs -> int2Double . fromEnum . diverse2GGL sels zs . concatMap string1 . stringToXG wrs $ xs
           FSLG _ -> 1.0) g
{-# INLINE procDiverse2F #-}

--------------------------------------------------------------------------------------------

eval23Coeffs :: Coeffs2 -> [Double] -> Double
eval23Coeffs (CF2 x y) = evalRhythmicity23K (fromMaybe 1.0 x) (fromMaybe 1.0 y)
eval23Coeffs CF0 = evalRhythmicity23
{-# INLINE eval23Coeffs #-}

eval23CoeffsF :: Factors -> Double -> Coeffs2 -> [Double] -> Double
eval23CoeffsF ff k (CF2 x y) = evalRhythmicity23KF ff k (fromMaybe 1.0 x) (fromMaybe 1.0 y)
eval23CoeffsF ff k CF0 = evalRhythmicity23F ff k
{-# INLINE eval23CoeffsF #-}

-------------------------------------------------------------------------------------------

procB2FG
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> 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.
  -> ([Double] -> Double)
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String   -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2FG wrs ks arr gs us vs h1 h g coeffs sels =  
  D (\t -> case t of
             StrG xs -> let ys = concatMap string1 . stringToXG wrs $ xs in
                                ((int2Double . fromEnum . diverse2GGL sels zs $ ys)*(h1 . mconcat . (fromMaybe (const [[-5.0]])  (fromPhoPaaW g)) . map (divSylls . reSyllableCntnts ks gs . 
                                 groupSnds . str2PRSs arr) . words1 . mapMaybe (f us vs) $ ys))
             FSLG tsss -> h1 . mconcat . (fromMaybe (const [[-6.0]]) (fromSaaW g)) $ tsss) h
                  where  zs = ' ':us `mappend` vs
{-# INLINE procB2FG #-}

procB2F
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> 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.
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String   -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2F wrs ks arr gs us vs h g coeffs = procB2FG wrs ks arr gs us vs (eval23Coeffs coeffs) h g coeffs
{-# INLINE procB2F #-}

procB2FF
  :: (Ord c) =>  Factors
  -> GWritingSystemPRPLX
  -> [(Char,Char)]
  -> 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.
  -> Double 
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2FF ff wrs ks arr gs us vs k h g coeffs = procB2FG wrs ks arr gs us vs (eval23CoeffsF ff k coeffs) h g coeffs
{-# INLINE procB2FF #-}

procB2InvFG
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> 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.
  -> ([Double] -> Double)
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2InvFG wrs ks arr gs us vs h1 h g coeffs sels = 
  D (\t -> case t of
             StrG xs ->
               let !ys = concatMap string1 . stringToXG wrs $ xs
                   !z = diverse2GGL sels zs ys in if z == 0 then  (h1 . mconcat . (fromMaybe (const [[-5.0]]) (fromPhoPaaW g)) . map (divSylls . reSyllableCntnts ks gs . groupSnds .
                         str2PRSs arr) . words1 . mapMaybe (f us vs) $ ys) ** 2.0
                           else  ((h1 . mconcat . (fromMaybe (const [[-5.0]]) (fromPhoPaaW g)) . map (divSylls . reSyllableCntnts ks gs . groupSnds . str2PRSs arr) . words1 .
                              mapMaybe (f us vs) $ ys) / (int2Double . fromEnum $ z))
             FSLG tsss -> h1 . mconcat . (fromMaybe (const [[-6.0]]) (fromSaaW g)) $ tsss) h
                   where  zs = ' ':us `mappend` vs
{-# INLINE procB2InvFG #-}

procB2InvF
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> 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.
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2InvF wrs ks arr gs us vs h g coeffs= procB2InvFG wrs ks arr gs us vs (eval23Coeffs coeffs) h g coeffs
{-# INLINE procB2InvF #-}

procB2InvFF
  :: (Ord c) => Factors
  -> GWritingSystemPRPLX
  -> [(Char,Char)]
  -> 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.
  -> Double
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2InvFF ff wrs ks arr gs us vs k h g coeffs = procB2InvFG wrs ks arr gs us vs (eval23CoeffsF ff k coeffs) h g coeffs
{-# INLINE procB2InvFF #-}

---------------------------------------------------------------------

procRhythm23F
  :: (Ord c) => (Double -> c)
  -> String
  -> (String -> Coeffs2 -> ReadyForConstructionPL -> Double)
  -> Coeffs2
  -> FuncRep2 ReadyForConstructionPL Double c
procRhythm23F h choice g coeffs = D (g choice coeffs) h
{-# INLINE procRhythm23F #-}

procRhythmicity23F
  :: (Ord c) => Factors
  -> Double
  -> (Double -> c)
  -> (Double -> String -> MappingFunctionPL)
  -> String
  -> Coeffs2
  -> GWritingSystemPRPLX
  -> [(Char,Char)]
  -> 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 -- ^ The starting 'String' which defines the line to be constructed
  -> FuncRep2 ReadyForConstructionPL Double c
procRhythmicity23F ff k g h choice coeffs wrs ks arr hs us vs bbs = D (rhythmicity ff k choice h coeffs bbs wrs ks arr hs us vs) g
{-# INLINE procRhythmicity23F #-}

-------------------------------------------------------------

f us vs x
  | x `elem` us = Nothing
  | x `notElem` vs = Just x
  | otherwise = Just ' '
{-# INLINE f #-}

words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
  where ts = dropWhile (== ' ') xs
        (w, s'') = break (== ' ') ts
{-# NOINLINE words1 #-}