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

-- |
-- Module      :  Phonetic.Languages.Simple
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- The library functions for the lineVariantsG3 executable. Since 0.4.0.0 version it supports printing of the informational
-- messages both in English and Ukrainian.

module Phonetic.Languages.Simple where

import Phonetic.Languages.Parsing
import Numeric
import Languages.UniquenessPeriods.Array.Constraints.Encoded (decodeLConstraints,readMaybeECG)
import GHC.Arr
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2
import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI)
import Phonetic.Languages.Simplified.StrictVG.Base
import Data.Char (isDigit,isAlpha)
import qualified Data.List  as L (span,sort,zip4,isPrefixOf,nub)
import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2
import Phonetic.Languages.Permutations.Arr
import Data.SubG hiding (takeWhile,dropWhile)
import Data.Maybe
import Data.MinMax.Preconditions
import Text.Read (readMaybe)
import Phonetic.Languages.Simplified.DeEnCoding
import Phonetic.Languages.Simplified.SimpleConstraints
import Phonetic.Languages.Common

forMultiplePropertiesF :: [String] -> [(String,[String])]
forMultiplePropertiesF (xs:xss)
 | any isAlpha xs = (xs,yss):forMultiplePropertiesF zss
 | otherwise = []
     where l = length . takeWhile (all isDigit) $ xss
           (yss,zss) = splitAt l xss
forMultiplePropertiesF _ = []

{-|
@ since 0.3.0.0
Is used to do general processment.
@ 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
Changed the arguments signing so that capital letters changed to the small ones, double ++ changed to just singular +.

-}
generalProc2G :: Bool -> FilePath -> Bool -> Bool -> [String] -> Coeffs2 -> Coeffs2 -> [String] -> Bool -> IO ()
generalProc2G nativeUkrainian toFile1 interactive jstL0 args0 coeffs coeffsWX args lstW2
 | variations args = do
    let !zsss = transformToVariations args
    print zsss
    variantsG <- mapM (\xss -> generalProc2 nativeUkrainian interactive jstL0 args0 coeffs coeffsWX xss lstW2) zsss
    interactivePrintResult nativeUkrainian id variantsG >>= \rs ->
      case toFile1 of
       "" -> return ()
       ~fileName -> appendFile fileName (rs `mappend` newLineEnding)
 | otherwise = generalProc2 nativeUkrainian interactive jstL0 args0 coeffs coeffsWX args lstW2 >>= \rs ->
      case toFile1 of
       "" -> return ()
       ~fileName -> appendFile fileName (rs `mappend` newLineEnding)

-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
generalProc2 :: Bool -> Bool -> Bool -> [String] -> Coeffs2 -> Coeffs2 -> [String] -> Bool -> IO String
generalProc2 nativeUkrainian interactive jstL0 args0 coeffs coeffsWX args lstW2 = do
  let !argMss = take 5 . filter (not . null) . forMultiplePropertiesF . drop 1 . dropWhile (/= "+m") . takeWhile (/= "-m") $ args0
  if null argMss then do
   let (!numericArgs,!textualArgs) = L.span (all isDigit) $ args
       !xs = concat . take 1 . fLines 0 . unwords . drop 1 $ textualArgs
       !l = length . words $ xs
       !argCs = catMaybes (fmap (readMaybeECG (l - 1)) . (showB l lstW2:) . drop 1 . dropWhile (/= "+a") . takeWhile (/= "-a") $ args0)
       !arg0 = fromMaybe 1 $ (readMaybe (concat . take 1 $ numericArgs)::Maybe Int)
       !numberI = fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ numericArgs)::Maybe Int)
       !choice = concat . take 1 $ textualArgs
       !intervalNmbrs = (\zs -> if null zs then [numberI] else L.nub zs) . L.sort . filter (<= numberI) .
           map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ numericArgs
   if compare l 2 == LT then let !frep20 = if take 1 choice == "x" || take 1 choice == "w" then chooseMax id coeffsWX choice else chooseMax id coeffs choice in let !wwss = (:[]) . toResultR frep20 $ xs in
    if interactive then interactivePrintResult nativeUkrainian line wwss else print1el jstL0 choice wwss
   else do
    let !subs = subG " 01-" xs
    if null argCs then let !perms = genPermutationsL l in do
          temp <- generalProcMs coeffs coeffsWX perms subs (intervalNmbrs, arg0, numberI, choice)
          if interactive then interactivePrintResult nativeUkrainian line temp else print1el jstL0 choice temp
    else do
     correct <- printWarning nativeUkrainian xs
     if correct == "n" then putStrLn (messageInfo 1 nativeUkrainian) >> return "" -- for the multiple variations mode (with curly brackets and slash in the text) the program does not stop here, but the variation is made empty and is proposed further as a variant.
     else let !perms = decodeLConstraints argCs . genPermutationsL $ l in do
          temp <- generalProcMs coeffs coeffsWX perms subs (intervalNmbrs, arg0, numberI, choice)
          if interactive then interactivePrintResult nativeUkrainian line temp else print1el jstL0 choice temp
  else do
   let !choices = map fst argMss
       !numericArgss = map snd argMss
       !arg0s = map (\ts -> fromMaybe 1 $ (readMaybe (concat . take 1 $ ts)::Maybe Int)) numericArgss
       !numberIs = map (\ts -> fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ ts)::Maybe Int)) numericArgss
       !intervalNmbrss = map (\us -> let !numberI = fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ us)::Maybe Int) in
         (\zs -> if null zs then [numberI] else L.nub zs) . L.sort . filter (<= numberI) .
           map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ us) $ numericArgss
       !argsZipped = L.zip4 intervalNmbrss arg0s numberIs choices
       !xs = concat . take 1 . fLines 0 . unwords $ args
       !l = length . words $ xs
       !argCs = catMaybes (fmap (readMaybeECG (l - 1)) . (showB l lstW2:) . drop 1 . dropWhile (/= "+a") . takeWhile (/= "-a") $ args0)
   if compare l 2 == LT then let !frep20 = chooseMax id coeffs (concat . take 1 $ choices)
    in let !wwss = (:[]) . toResultR frep20 $ xs in if interactive then interactivePrintResult nativeUkrainian line wwss else print1el jstL0 (concat . take 1 $ choices) wwss
   else do
    let !subs = subG " 01-" xs
    if null argCs then let !perms = genPermutationsL l in generalProcMMs nativeUkrainian interactive coeffs coeffsWX argsZipped perms subs
    else do
     correct <- printWarning nativeUkrainian xs
     if correct == "n" then putStrLn (messageInfo 1 nativeUkrainian) >> return "" -- for the multiple variations mode (with curly brackets and slash in the text) the program does not stop here, but the variation is made empty and is proposed further as a variant.
     else let !perms = decodeLConstraints argCs . genPermutationsL $ l in generalProcMMs nativeUkrainian interactive coeffs coeffsWX argsZipped perms subs

{-|
-- @ since 0.4.0.0
Function provides localized message information. If the 'Bool' argument is 'True' then it gives result in Ukrainian, otherwise -- in English.
-}
messageInfo :: Int -> Bool -> String
messageInfo n True
 | n == 1 = "Ви зупинили програму, будь ласка, якщо потрібно, виконайте її знову з кращими аргументами. "
 | n == 2 = "Будь ласка, вкажіть варіант (який Ви бажаєте, щоб він став результуючим рядком) за його номером. "
 | n == 3 = "Будь ласка, перевірте, чи рядок нижче відповідає і узгоджується з обмеженнями, які Ви вказали між +a та -a опціями. Перевірте також, чи Ви вказали \"+b\" чи \"+bl\" опцію(ї). Якщо введені опції та аргументи не узгоджені з виведеним далі рядком, тоді введіть далі \"n\", натисніть Enter і опісля запустіть програму на виконання знову з кращими аргументами. " `mappend` newLineEnding `mappend` "Якщо рядок узгоджується з Вашим вводом між +a та -a, тоді просто натисніть Enter, щоб продовжити далі. " `mappend` newLineEnding
 | n == 4 = "Було задано недостатньо інформації для продовження обчислювального процесу "
 | n == 5 = "(/ Ви вказали властивості(ість) та діапазон(и) для них такі, що для даних слів та їх сполучень варіантів немає. Спробуйте змінити параметри виклику програми (бібліотеки) /)"
 | otherwise = "Ви вказали лише один варіант властивостей. "
messageInfo n False
 | n == 1 = "You stopped the program, please, if needed, run it again with better arguments. "
 | n == 2 = "Please, specify the variant which you would like to become the resulting string by its number. "
 | n == 3 = "Please, check whether the line below corresponds and is consistent with the constraints you have specified between the +a and -a options. Check also whether you have specified the \"+b\" or \"+bl\" option(s). If it is inconsistent then enter further \"n\", press Enter and then run the program again with better arguments. " `mappend` newLineEnding `mappend` "If the line is consistent with your input between +a and -a then just press Enter to proceed further. " `mappend` newLineEnding
 | n == 4 = "No data has been specified to control the computation process. "
 | n == 5 = "(/ You have specified properties / property and the range(s) so that for the words and their concatenations there are no variants available. Try to change the call parameters /)"
 | otherwise = "You have specified just one variant of the properties. "

-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
-- @ since 0.8.0.0 The function has also the option for the empty result.
interactivePrintResult :: Bool -> (a -> String) -> [a] -> IO String
interactivePrintResult nativeUkrainian f xss
  | null xss = putStrLn "" >> return ""
  | otherwise = do
     let !datas = map (\(idx,str) -> show idx `mappend` ('\t' : str)) . trans232 . map f $ xss
     if null datas then (putStrLn . messageInfo 5 $ nativeUkrainian) >> return ""
     else do
      mapM_ putStrLn datas
      putStrLn ""
      putStrLn . messageInfo 2 $ nativeUkrainian
      number <- getLine
      let !lineRes = concat . filter ((number `mappend` "\t")`L.isPrefixOf`) $ datas
          !ts = drop 1 . dropWhile (/= '\t') $ lineRes
      putStrLn ts >> return ts

printWarning :: Bool -> String -> IO String
printWarning nativeUkrainian xs = do
  putStrLn . messageInfo 3 $ nativeUkrainian
  putStrLn xs
  getLine

generalProcMs :: Coeffs2 -> Coeffs2 -> [Array Int Int] -> [String] -> ([Int],Int,Int,String) -> IO [Result [] Char Double Double]
generalProcMs coeffs coeffsWX perms subs (intervalNmbrs, arg0, numberI, choice) = do
  if compare numberI 2 == LT then let !frep2 = if take 1 choice == "x" || take 1 choice == "w" then chooseMax id coeffsWX choice else chooseMax id coeffs choice
   in return . fst . maximumGroupsClassificationR arg0 . map (toResultR frep2) . uniquenessVariants2GNBL ' ' id id id perms $ subs
  else do
    let !variants1 = uniquenessVariants2GNBL ' ' id id id perms subs
        !frep20 = if take 1 choice == "x" || take 1 choice == "w" then chooseMax id coeffsWX choice else chooseMax id coeffs choice
        (!minE,!maxE) = minMax11C . map (toPropertiesF' frep20) $ variants1
        !frep2 = if take 1 choice == "x" || take 1 choice == "w" then chooseMax (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs) coeffsWX choice else chooseMax (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs) coeffs choice
    return . fst . maximumGroupsClassificationR arg0 . map (toResultR frep2) $ variants1

-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
generalProcMMs :: Bool -> Bool -> Coeffs2 -> Coeffs2 -> [([Int],Int,Int,String)] -> [Array Int Int] -> [String] -> IO String
generalProcMMs nativeUkrainian interactiveMM coeffs coeffsWX rs perms subs =
 case length rs of
  0 -> putStrLn (messageInfo 4 nativeUkrainian) >> return ""
  1 -> putStrLn (messageInfo 5 nativeUkrainian) >> do
        temp <- generalProcMs coeffs coeffsWX perms subs (head rs)
        finalProc nativeUkrainian interactiveMM line temp
  _ -> do
         genVariants <- mapM (generalProcMs coeffs coeffsWX perms subs) rs
         finalProc nativeUkrainian interactiveMM id . foldlI . map (map line) $ genVariants

foldlI :: [[String]] -> [String]
foldlI (xs:ys:xss) = foldlI (intersectInterResults xs ys : xss)
foldlI (xs:_) = xs
foldlI _ = []

-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
finalProc :: Bool -> Bool -> (a -> String) -> [a] -> IO String
finalProc nativeUkrainian bool f xss = if bool then interactivePrintResult nativeUkrainian f xss else putStrLn ts >> return ts
  where ts = concatMap (\t -> f t `mappend` newLineEnding) xss

-- |
-- @ since 0.3.0.0 The result is not 'IO' (), but 'IO' 'String'. The type also changed generally.
print1el :: Bool -> String -> [Result [] Char Double Double] -> IO String
print1el jstlines choice y
 | jstlines == True = putStrLn us >> return us
 | otherwise = putStrLn zs >> return zs
       where !ch = precChoice choice
             !us = concatMap (\ys -> line ys `mappend` newLineEnding) y
             !zs = concatMap (\ys -> line ys `mappend` newLineEnding `mappend` showFFloat ch (propertiesF ys) (newLineEnding `mappend` showFFloat ch (transPropertiesF ys) newLineEnding)) y