{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}

-- |
-- Module      :  Phonetic.Languages.GetTextualInfo
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Library module that contains functions used by the propertiesTextG3
-- executable.

module Phonetic.Languages.GetTextualInfo (
  generalProc
  , linesFromArgs1
  , linesFromArgsG
  , getData3
  , process1Line
) where

import Data.SubG hiding (takeWhile,dropWhile)
import System.IO
import Control.Concurrent
import Control.Exception
import Control.Parallel.Strategies
import Data.Maybe (fromMaybe)
import Data.List (sort)
import Text.Read (readMaybe)
import GHC.Arr
import Melodics.ByteString.Ukrainian.Arr
import Phonetic.Languages.Ukrainian.PrepareText
import Numeric (showFFloat)
import Phonetic.Languages.Filters
import Data.Char (isAlpha)
import Data.Statistics.RulesIntervalsPlus
import Data.MinMax.Preconditions
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2
import Phonetic.Languages.Simplified.StrictVG.Base
import Phonetic.Languages.Permutations.Arr
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2
import Languages.UniquenessPeriods.Array.Constraints.Encoded
import Phonetic.Languages.Simplified.SimpleConstraints
import Phonetic.Languages.Common

{-| @ since 0.5.0.0 -- The meaning of the first command line argument (and 'Coeffs2' here everywhere in the module)
depends on the 'String' argument -- whether it starts with \'w\', \'x\' or otherwise. In the first case it represents
the k1 and k2 coefficients (default ones equal to 2.0 and 0.125) for the functions from the Rhythmicity.TwoFourth module.
Otherwise, it is used for the functions to specify the level of emphasizing the two-based and three-based periods
(the default values here are 1.0 both).
@ since 0.6.0.0 -- There is also the possibility to use \'line growing\' that is to use the 'prepereGrowTextMN' function
with the 'Int' arguments from the first argument tuple. This allows to rearrange the given text and then
to rewrite it.
Besides there are new lines of the arguments for the 'String' argument that can begin with \"c\", \"s\", \"t\",
\"u\", \"v\", \"C\", \"N\", \"S\", \"T\", \"U\", \"V\", \"W\", \"X\", \"Y\" and \"Z\" letters. For more information, please, refer to the 'Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2.rhythmicity'.
-}
generalProc :: (Int,Int) -> Bool -> [String] -> [String] -> Coeffs2 -> Coeffs2 -> FilePath -> String -> Int -> Int -> String -> IO ()
generalProc (gr1,gr2) lstW multiples2 lInes coeffs coeffsWX file gzS printLine toOneLine choice
 | null lInes = do
    contents <- readFile file
    let !flines
          | gr1 == 0 = fLines toOneLine contents
          | otherwise = prepareGrowTextMN gr1 gr2 . unlines . fLines toOneLine $ contents
    getData3 lstW coeffs coeffsWX (getIntervalsNS lstW gzS flines) printLine choice multiples2 flines
 | otherwise = do
    contents <- readFile file
    let !flines = (if gr1 == 0 then id else prepareGrowTextMN gr1 gr2 . unlines) . fLines toOneLine . unlines . linesFromArgsG lInes . fLines 0 $ contents
    getData3 lstW coeffs coeffsWX (getIntervalsNS lstW gzS flines) printLine choice multiples2 flines

linesFromArgs1 :: Int -> String -> [String] -> [String]
linesFromArgs1 n xs yss =
  let (!ys,!zs) = (\(x,z) -> (x, drop 1 z)) . break (== ':') $ xs
      !ts = sort . map (min n . abs) $ [fromMaybe 1 (readMaybe ys::Maybe Int), fromMaybe n (readMaybe zs::Maybe Int)] in
        drop (head ts - 1) . take (last ts) $ yss

linesFromArgsG :: [String] -> [String] -> [String]
linesFromArgsG xss yss = let n = length yss in concatMap (\ts -> linesFromArgs1 n ts yss) xss

getData3 :: Bool -> Coeffs2 -> Coeffs2 -> Int -> Int -> String -> [String] -> [String] -> IO ()
getData3 lstW coeffs coeffsWX gz printLine choice multiples3 zss = let !permsV4 = genPermutationsArrL in putStrLn (replicate (length multiples3 + 1) '\t' `mappend` show gz) >> mapM_ (process1Line lstW coeffs coeffsWX gz printLine choice multiples3 permsV4) zss

process1Line :: Bool -> Coeffs2 -> Coeffs2 -> Int -> Int -> String -> [String] -> Array Int [Array Int Int] -> String -> IO ()
process1Line lstW coeffs coeffsWX gz printLine choice multiples4 !permsV50 v
 | null multiples4 = bracket (do {
    myThread <- forkIO (do
     let !v2 = words v
         !l2 = length v2 - 2
     if l2 >= (if lstW then 1 else 0) then do
      let !permsV5 = decodeConstraint1 (fromMaybe (E 1) . readMaybeECG (l2 + 1) . showB (l2 + 2) $ lstW) .
            unsafeAt permsV50 $ l2
          ((!minE,!maxE),!data2) = runEval (parTuple2 rpar rpar (minMax11C . map (toTransPropertiesF' (if take 1 choice == "x" || take 1 choice == "w" then chooseMax id coeffsWX choice else chooseMax id coeffs choice)) .
                uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF' (if take 1 choice == "x" || take 1 choice == "w" then chooseMax id coeffsWX choice else chooseMax id coeffs choice) . unwords . subG " 01-" $ v))
          (!wordsN,!intervalN) = (l2 + 2, intervalNRealFrac minE maxE gz data2)
          !ratio = if maxE == 0.0 then 0.0 else 2.0 * data2 / (minE + maxE)
      hPutStr stdout . showFFloat (precChoice choice) minE $ "\t"
      hPutStr stdout . showFFloat (precChoice choice) data2 $ "\t"
      hPutStr stdout . showFFloat (precChoice choice) maxE $ "\t"
      hPutStr stdout . showFFloat (Just 4) (data2 / minE) $ "\t"
      hPutStr stdout . showFFloat (Just 4) (maxE / minE) $ "\t"
      hPutStr stdout . showFFloat (Just 4) (maxE / data2) $ "\t"
      hPutStr stdout . showFFloat (Just 8) ratio $ "\t"
      hPutStr stdout ('\t':show (wordsN::Int))
      hPutStr stdout ('\t':show (intervalN::Int))
      hPutStrLn stdout (if printLine == 1 then '\t':v else "")
     else putStrLn (replicate (length multiples4) '\t' ++ if printLine == 1 then '\t':v else ""))
   ; return myThread }) (killThread) (\_ -> putStr "")
 | otherwise = bracket (do {
   myThread <- forkIO (do
    let !v2 = words v
        !l2 = length v2 - 2
    if l2 >= (if lstW then 1 else 0) then do
     let !permsV5 = decodeConstraint1 (fromMaybe (E 1) . readMaybeECG (l2 + 1) . showB (l2 + 2) $ lstW) .
            unsafeAt permsV50 $ l2
         rs = parMap rpar (\choiceMMs -> (minMax11C .
           map (toTransPropertiesF' (if take 1 choiceMMs == "x" || take 1 choiceMMs == "w" then chooseMax id coeffsWX choiceMMs else chooseMax id coeffs choiceMMs)) .
             uniquenessVariants2GNBL ' ' id id id permsV5 $ v2,
               toTransPropertiesF' (if take 1 choiceMMs == "x" || take 1 choiceMMs == "w" then chooseMax id coeffsWX choiceMMs else chooseMax id coeffs choiceMMs) .
                 unwords . subG " 01-" $ v,gz)) multiples4
         (!wordsN,!intervalNs) = (l2 + 2, map (\((!x,!y),!z,!t) -> intervalNRealFrac x y t z) rs)
           in do
            hPutStr stdout (show (wordsN::Int))
            mapM_ (\i -> hPutStr stdout ('\t':show (i::Int))) intervalNs
            hPutStrLn stdout (if printLine == 1 then '\t':v else "")
    else putStrLn (replicate (length multiples4) '\t' ++ if printLine == 1 then '\t':v else ""))
  ; return myThread }) (killThread) (\_ -> putStr "")