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

-- |
-- Module      :  Phonetic.Languages.GetTextualInfo
-- Copyright   :  (c) OleksandrZhabenko 2020
-- 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

generalProc :: Bool -> [String] -> [String] -> Coeffs2 -> FilePath -> String -> Int -> Int -> String -> IO ()
generalProc lstW multiples2 lInes coeffs file gzS printLine toOneLine choice
 | null lInes = do
    contents <- readFile file
    let !flines = fLines toOneLine contents
    getData3 lstW coeffs (getIntervalsNS lstW gzS flines) printLine choice multiples2 flines
 | otherwise = do
    contents <- readFile file
    let !flines = fLines toOneLine . unlines . linesFromArgsG lInes . fLines 0 $ contents
    getData3 lstW coeffs (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 -> Int -> Int -> String -> [String] -> [String] -> IO ()
getData3 lstW coeffs gz printLine choice multiples3 zss = let !permsV4 = genPermutationsArrL in putStrLn (replicate (length multiples3 + 1) '\t' `mappend` show gz) >> mapM_ (process1Line lstW coeffs gz printLine choice multiples3 permsV4) zss

process1Line :: Bool -> Coeffs2 -> Int -> Int -> String -> [String] -> Array Int [Array Int Int] -> String -> IO ()
process1Line lstW coeffs 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' (chooseMax id coeffs choice )) .
                uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF' (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' (chooseMax id coeffs choiceMMs)) .
             uniquenessVariants2GNBL ' ' id id id permsV5 $ v2,
               toTransPropertiesF' (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 "")