{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phladiprelio.Ukrainian.Common
-- 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. Instead of vectors, uses arrays.

{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}

module Phladiprelio.Ukrainian.Common where

import GHC.Base
import GHC.List
import Phladiprelio.Basis
import Phladiprelio.Rhythmicity.Simple
import Phladiprelio.Rhythmicity.Factor
import Data.Maybe (fromMaybe,isNothing)
import Phladiprelio.Rhythmicity.PolyRhythm
import Text.Read (readMaybe)
import Phladiprelio.Coeffs

procRhythm23F
  :: (Ord c) => (Double -> c)
  -> String
  -> (String -> Coeffs2 -> String -> Double)
  -> Coeffs2
  -> FuncRep2 String Double c
procRhythm23F :: forall c.
Ord c =>
(Double -> c)
-> String
-> (String -> Coeffs2 -> String -> Double)
-> Coeffs2
-> FuncRep2 String Double c
procRhythm23F Double -> c
h String
choice String -> Coeffs2 -> String -> Double
g Coeffs2
coeffs = forall a b c. (a -> b) -> (b -> c) -> FuncRep2 a b c
Phladiprelio.Basis.D (String -> Coeffs2 -> String -> Double
g String
choice Coeffs2
coeffs) Double -> c
h
{-# INLINE procRhythm23F #-}

parseChRhEndMaybe :: ParseChRh -> Maybe Int
parseChRhEndMaybe :: ParseChRh -> Maybe Int
parseChRhEndMaybe (P0 String
_) = forall a. Maybe a
Nothing
parseChRhEndMaybe (P1 Choices
_ RhythmBasis
_ Int
n) = forall a. a -> Maybe a
Just Int
n
parseChRhEndMaybe (P2 PolyChoices
_ PolyRhythmBasis
_ Int
_ Int
n) = forall a. a -> Maybe a
Just Int
n

eval23Coeffs :: Coeffs2 -> [Double] -> Double
eval23Coeffs :: Coeffs2 -> [Double] -> Double
eval23Coeffs (CF2 Maybe Double
x Maybe Double
y) = forall a. (RealFrac a, Floating a) => a -> a -> [a] -> a
evalRhythmicity23K (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
eval23Coeffs Coeffs2
CF0 = forall a. (RealFrac a, Floating a) => [a] -> a
evalRhythmicity23
{-# INLINE eval23Coeffs #-}

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

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

eval23 :: [[Double]] -> Double
eval23 = forall a. (RealFrac a, Floating a) => [a] -> a
evalRhythmicity23 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
{-# INLINE eval23 #-}

eval23K :: c -> c -> [[c]] -> c
eval23K c
k2 c
k3 = forall a. (RealFrac a, Floating a) => a -> a -> [a] -> a
evalRhythmicity23K c
k2 c
k3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
{-# INLINE eval23K #-}

eval23F :: Factors -> Double -> [[Double]] -> Double
eval23F Factors
ff Double
k = Factors -> Double -> [Double] -> Double
evalRhythmicity23F Factors
ff Double
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
{-# INLINE eval23F #-}

eval23KF :: Factors -> Double -> Double -> Double -> [[Double]] -> Double
eval23KF Factors
ff Double
k Double
k2 Double
k3 = Factors -> Double -> Double -> Double -> [Double] -> Double
evalRhythmicity23KF Factors
ff Double
k Double
k2 Double
k3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
{-# INLINE eval23KF #-}

words1 :: [a] -> [[a]]
words1 [a]
xs = if forall a. [a] -> Bool
null [a]
ts then [] else [a]
w forall a. a -> [a] -> [a]
: [a] -> [[a]]
words1 [a]
s'' -- Is inspired by Data.List.words function.
  where ts :: [a]
ts = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
> a
99) [a]
xs
        ([a]
w, [a]
s'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Ord a => a -> a -> Bool
< a
100) [a]
ts
{-# NOINLINE words1 #-}