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

-- |
-- Module      :  Phonetic.Languages.General.GetTextualInfo
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Library module that contains functions earlier used by the propertiesTextG3
-- executable for the Ukrainian language (see: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array).
-- Is rewritten from the Phonetic.Languages.GetTextualInfo module from the
-- @phonetic-languages-simplified-examples-array@ package.

module Phonetic.Languages.General.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 Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.PrepareText
import Numeric (showFFloat)
import Phonetic.Languages.Filters
import Data.Char (isAlpha)
import Data.Statistics.RulesIntervalsPlus
import Data.MinMax.Preconditions
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Phonetic.Languages.Simplified.StrictVG.Base
import Phonetic.Languages.Permutations.Arr
import Phonetic.Languages.Permutations.ArrMini
import Phonetic.Languages.Permutations.ArrMini1
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Basis
import Phonetic.Languages.Simplified.DataG.Partir
import Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2
import Languages.UniquenessPeriods.Array.Constraints.Encoded
import Phonetic.Languages.General.SimpleConstraints
import Phonetic.Languages.General.Common
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
import qualified Phonetic.Languages.Permutations.Represent as R
import Phonetic.Languages.EmphasisG

generalProc
 :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> (Int,Int) -- ^ Argument to specify possible 'line growing'.
 -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL] -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> String
 -> String
 -> String
 -> Bool
 -> [String]
 -> [String]
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> FilePath
 -> String
 -> Int
 -> Int
 -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one. Since 0.5.0.0 version can also
 -- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions.
 -- @ 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.
 -> IO ()
generalProc pairwisePermutations (gr1,gr2) wrs ks arr gs h rs ysss zzzsss xs js vs lstW multiples2 lInes coeffs coeffsWX file gzS printLine toOneLine choice
 | null lInes = do
    contents <- readFile file
    let !flines
           | gr1 == 0 = fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs toOneLine contents
           | otherwise = prepareGrowTextMN gr1 gr2 ysss zzzsss xs . unlines . fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs toOneLine $ contents
    getData3 pairwisePermutations wrs ks arr gs js vs h rs lstW coeffs coeffsWX (getIntervalsNS lstW gzS flines) printLine choice multiples2 flines
 | otherwise = do
    contents <- readFile file
    let !flines
           | gr1 == 0 = fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs toOneLine . unlines . linesFromArgsG lInes . fLines ysss zzzsss xs js vs 0 $ contents
           | otherwise = prepareGrowTextMN gr1 gr2 ysss zzzsss xs . unlines . fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs toOneLine . unlines . linesFromArgsG lInes . fLines ysss zzzsss xs js vs 0 $ contents
    getData3 pairwisePermutations wrs ks arr gs js vs h rs 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
 :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL] -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> Bool
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> Int
 -> Int
 -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one. Since 0.5.0.0 version can also
 -- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions.
 -- @ 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.
 -> [String]
 -> [String]
 -> IO ()
getData3 pairwisePermutations wrs ks arr gs js vs h rs lstW coeffs coeffsWX gz printLine choice0 multiples3 zss =
  let  !choice = filter (/='a') choice0
       !permsV4 = case pairwisePermutations of
        R.P 2 -> genPairwisePermutationsArrLN 10
        R.P 1 -> genElementaryPermutationsArrLN1 10
        _ -> genPermutationsArrL in do
          putStrLn (replicate (length multiples3 + 1) '\t' `mappend` show gz)
          mapM_ (process1Line wrs ks arr gs js vs h rs lstW coeffs coeffsWX gz printLine choice multiples3 permsV4) zss

process1Line
 :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL]  -- ^ A list of either 'PhoPaaW'-based or 'SaaW'-based (and not both ones) different functions that specifies the syllables durations in the PhoPaaW or SaaW mode respectively (the former one has been introduced earlier), analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one in case of 'PhoPaaW'-based ones must be probably the most
 -- exact one and, therefore, the default one.
 -> Bool
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> Int
 -> Int
 -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one. Since 0.5.0.0 version can also
 -- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions.
 -- @ 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.
 -> [String]
 -> Array Int [Array Int Int]  -- ^ A permutations array of indices.
 -> String
 -> IO ()
process1Line wrs ks arr gs js vs h qs 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'2 (if take 1 choice == "w" || take 1 choice == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX qs choice "" else chooseMax wrs ks arr gs js vs id h coeffs qs choice "")) .
                map StrG . uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF'2 (if take 1 choice == "w" || take 1 choice == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX qs choice "" else chooseMax wrs ks arr gs js vs id h coeffs qs choice "") .
                 StrG . unwords . subG (' ':js `mappend` vs) $ 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'2 (if take 1 choiceMMs == "w" || take 1 choiceMMs == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX qs choiceMMs "" else chooseMax wrs ks arr gs js vs id h coeffs qs choiceMMs "")) .
             map StrG . uniquenessVariants2GNBL ' ' id id id permsV5 $ v2,
               toTransPropertiesF'2 (if take 1 choiceMMs == "w" || take 1 choiceMMs == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX qs choiceMMs "" else chooseMax wrs ks arr gs js vs id h coeffs qs choiceMMs "") .
                 StrG . unwords . subG (' ':js `mappend` vs) $ 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 "")