-- |
-- Module      :  DobutokO.Sound.Aftovolio.Ukrainian.Filter
-- Copyright   :  (c) OleksandrZhabenko 2025
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Provides an easy way to create some rhythmic patterns from a Ukrainian text. 
-- Uses aftovolioUkr executable inside from the @aftovolio@ package.

{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}
{-# OPTIONS_GHC -threaded #-}

module DobutokO.Sound.Aftovolio.Ukrainian.Filter (
  -- * Library and executable functions
  quantizeDurationsBasedOnUkrainianText
) where

import System.Exit (ExitCode(..))
import GHC.Base
import GHC.Num ((*),(-))
import GHC.Real (fromIntegral)
import Data.List
import System.IO (FilePath,hPutStrLn,stderr)
import Data.Char (isSpace)
import Data.Maybe (fromJust)
import System.Process (readProcessWithExitCode)
import EndOfExe2 (showE)
import Aftovolio.Halfsplit
import Aftovolio.General.Datatype3
import Aftovolio.Ukrainian.ReadDurations (readSyllableDurations)
import Aftovolio.Ukrainian.Syllable
import Aftovolio.Ukrainian.SyllableWord8
import Aftovolio.Ukrainian.Melodics
import TwoQuantizer (twoQuantizerG)

{-|
   'quantizeDurationsBasedOnUkrainianText' processes and quantizes syllable durations derived from a Ukrainian text that can be further used by DobutokO modules for creating music and sound patterns or timbre.

  This function performs several steps to produce a list of quantized durations. 

  It reads syllable durations, invoke aftovolioUkr executable with argements, processes and parses output and makes quantization of the result.

  In the event that the external process does not exit successfully, the function writes the error message to stderr
  and returns an empty list. -}
quantizeDurationsBasedOnUkrainianText 
  :: FilePath -- ^ A 'FilePath' to a file containing syllable durations. If empty, a default set of durations is selected based on @k@ (the 'Int' argument here).
  -> Int -- ^ An 'Int' used to select the specific group of durations from the file (if available) or determine which default list to use.
  -> [Double] -- ^ A list of 'Double' values representing quantization parameters. The resulting list will contain just the values from this list.
  -> String -- ^ A 'String' containing the Ukrainian text to be processed. This text is split into words and passed to the external executable @aftovolioUkr@.
  -> [String] -- ^ A list of additional command-line arguments (['String']) to be forwarded to the @aftovolioUkr@ executable.
  -> [String] -- ^ A list of 'String' values representing selected line numbers or indices to influence the processing of the Ukrainian text. If empty then the whole output is used without selection. If specified in the modes without tests and file single line output changes the output so that just the lines with the specified Int numbers are displayed in the order of the specified numbers. To specify some range, use just dash as here: \"34-250\" meaning that lines with numbers between 34 and 250 inclusively will be displayed. The output preserves music mode additional information as well here.
  -> IO [Double]
quantizeDurationsBasedOnUkrainianText :: FilePath
-> Int
-> [Double]
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO [Double]
quantizeDurationsBasedOnUkrainianText FilePath
file Int
k [Double]
quants FilePath
ukrstrs [FilePath]
argss [FilePath]
lineNumbersSels = do
    syllableDurationsDs <- FilePath -> IO [[[[Sound8]]] -> [[Word8]]]
readSyllableDurations FilePath
file
    (code, stdout0, strerr0) <- readProcessWithExitCode (fromJust (showE "aftovolioUkr")) (argss ++ concat [["+nm"], if null lineNumbersSels then ["1-362880"] else lineNumbersSels, ["-nm"]] ++ words ukrstrs) ""
    if code == ExitSuccess then do
        let basicDurations = (Word8 -> Double) -> [Word8] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> [Double])
-> (FilePath -> [Word8]) -> FilePath -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool)
-> Double -> (FilePath -> [Word8]) -> FilePath -> [Word8]
read3
                        (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))
                        Double
1.0
                        ( [[Word8]] -> [Word8]
forall a. Monoid a => [a] -> a
mconcat
                            ([[Word8]] -> [Word8])
-> (FilePath -> [[Word8]]) -> FilePath -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
file
                                    then case Int
k of
                                        Int
1 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD
                                        Int
3 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD3
                                        Int
4 -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD4
                                        Int
_ -> [[[Sound8]]] -> [[Word8]]
syllableDurationsD2
                                    else
                                        if [[[[Sound8]]] -> [[Word8]]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[[Sound8]]] -> [[Word8]]]
syllableDurationsDs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k
                                            then [[[[Sound8]]] -> [[Word8]]]
syllableDurationsDs [[[[Sound8]]] -> [[Word8]]] -> Int -> [[[Sound8]]] -> [[Word8]]
forall a. HasCallStack => [a] -> Int -> a
!! (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                            else [[[Sound8]]] -> [[Word8]]
syllableDurationsD2
                              )
                            ([[[Sound8]]] -> [[Word8]])
-> (FilePath -> [[[Sound8]]]) -> FilePath -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [[[Sound8]]]
createSyllablesUkrS
                        ) (FilePath -> [Word8])
-> (FilePath -> FilePath) -> FilePath -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unwords ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [Double]) -> FilePath -> [Double]
forall a b. (a -> b) -> a -> b
$ FilePath
stdout0
            quantizedDurations = Bool
-> (Double -> Double -> Double -> Ordering)
-> [Double]
-> [Double]
-> [Double]
forall a.
(Ord a, Floating a) =>
Bool -> (a -> a -> a -> Ordering) -> [a] -> [a] -> [a]
twoQuantizerG Bool
False (\Double
x Double
y Double
z -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
z) (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y)) [Double]
quants [Double]
basicDurations
        return quantizedDurations
    else hPutStrLn stderr strerr0 >> return []