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

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

module Phonetic.Languages.General.Simple where

import Phonetic.Languages.General.Parsing
import Numeric
import Languages.UniquenessPeriods.Array.Constraints.Encoded (decodeLConstraints,readMaybeECG)
import GHC.Arr
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI)
import Phonetic.Languages.Simplified.StrictVG.Base
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.PrepareText
import Data.Char (isDigit,isAlpha)
import qualified Data.List  as L (span,sort,zip4,isPrefixOf,nub)
import Phonetic.Languages.Simplified.Array.General.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.General.DeEnCoding
import Phonetic.Languages.General.SimpleConstraints
import Phonetic.Languages.General.Common
import Data.Phonetic.Languages.Syllables


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 _ = []

-- | Is used to do general processment.
generalProc2G
 :: 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 -> ([[[PRS]]] -> [[Double]])) -- ^ 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@.
 -> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most
  -- exact one and, therefore, the default one.
 -> Concatenations -- ^ Data used to concatenate 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
 -> FilePath
 -> Bool
 -> Bool
 -> [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.
 -> [String]
 -> Bool
 -> IO ()
generalProc2G wrs ks arr gs js vs h qs ysss ws toFile1 interactive jstL0 args0 coeffs coeffsWX args lstW2
 | variations args = do
    let !zsss = transformToVariations args
    print zsss
    variantsG <- mapM (\xss -> generalProc2 wrs ks arr gs js vs h qs ysss ws interactive jstL0 args0 coeffs coeffsWX xss lstW2) zsss
    interactivePrintResult id variantsG >>= \rs ->
      case toFile1 of
       "" -> return ()
       ~fileName -> appendFile fileName (rs `mappend` newLineEnding)
 | otherwise = generalProc2 wrs ks arr gs js vs h qs ysss ws interactive jstL0 args0 coeffs coeffsWX args lstW2 >>= \rs ->
      case toFile1 of
       "" -> return ()
       ~fileName -> appendFile fileName (rs `mappend` newLineEnding)

-- |
generalProc2
  :: 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 -> ([[[PRS]]] -> [[Double]])) -- ^ 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@.
  -> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most
  -- exact one and, therefore, the default one.
  -> Concatenations -- ^ Data used to concatenate 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
  -> Bool
  -> Bool
  -> [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.
  -> [String]
  -> Bool
  -> IO String
generalProc2 wrs ks arr gs js vs h qs ysss ws 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 ysss ws js vs 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 = chooseMax wrs ks arr gs js vs id h coeffs qs choice in let !wwss = (:[]) . toResultR frep20 $ xs in
    if interactive then interactivePrintResult line wwss else print1el jstL0 choice wwss
   else do
    let !subs = subG (' ':js `mappend` vs) xs
    if null argCs then let !perms = genPermutationsL l in do
          temp <- generalProcMs wrs ks arr gs js vs h qs coeffs coeffsWX perms subs (intervalNmbrs, arg0, numberI, choice)
          if interactive then interactivePrintResult line temp else print1el jstL0 choice temp
    else do
     correct <- printWarning xs
     if correct == "n" then putStrLn (messageInfo 1) >> 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 wrs ks arr gs js vs h qs coeffs coeffsWX perms subs (intervalNmbrs, arg0, numberI, choice)
          if interactive then interactivePrintResult 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 ysss ws js vs 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 wrs ks arr gs js vs id h coeffs qs (concat . take 1 $ choices) in
    let !wwss = (:[]) . toResultR frep20 $ xs in
       if interactive then interactivePrintResult line wwss
       else print1el jstL0 (concat . take 1 $ choices) wwss
   else do
    let !subs = subG (' ':js `mappend` vs) xs
    if null argCs then let !perms = genPermutationsL l in generalProcMMs wrs ks arr gs js vs h qs interactive coeffs coeffsWX argsZipped perms subs
    else do
     correct <- printWarning xs
     if correct == "n" then putStrLn (messageInfo 1) >> 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 wrs ks arr gs js vs h qs interactive coeffs coeffsWX argsZipped perms subs

-- | Function provides message information.
messageInfo :: Int -> String
messageInfo n
 | 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. "

-- |
interactivePrintResult :: (a -> String) -> [a] -> IO String
interactivePrintResult 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) >> return ""
     else do
      mapM_ putStrLn datas
      putStrLn ""
      putStrLn . messageInfo $ 2
      number <- getLine
      let !lineRes = concat . filter ((number `mappend` "\t")`L.isPrefixOf`) $ datas
          !ts = drop 1 . dropWhile (/= '\t') $ lineRes
      putStrLn ts >> return ts

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

generalProcMs
 :: 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 -> ([[[PRS]]] -> [[Double]])) -- ^ 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@.
 -> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most
  -- exact one and, therefore, the default one.
 -> 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.
 -> [Array Int Int]  -- ^ Permutations data.
 -> [String]
 -> ([Int],Int,Int,String) -- ^ The '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 (that is the default 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
 -- Changed the arguments signing so that capital letters changed to the small ones, double ++ changed to just singular +.
 -> IO [Result [] Char Double Double]
generalProcMs wrs ks arr gs js vs h qs coeffs coeffsWX perms subs (intervalNmbrs, arg0, numberI, choice) = do
  if compare numberI 2 == LT
   then let !frep2
              | take 1 choice == "w" || take 1 choice == "x" = chooseMax wrs ks arr gs js vs id h coeffsWX qs choice
              | otherwise = chooseMax wrs ks arr gs js vs id h coeffs qs 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
          | take 1 choice == "w" || take 1 choice == "x" = chooseMax wrs ks arr gs js vs id h coeffsWX qs choice
          | otherwise = chooseMax wrs ks arr gs js vs id h coeffs qs choice
        (!minE,!maxE) = minMax11C . map (toPropertiesF' frep20) $ variants1
        !frep2
          | take 1 choice == "w" || take 1 choice == "x" = chooseMax wrs ks arr gs js vs (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs) h coeffsWX qs choice
          | otherwise = chooseMax wrs ks arr gs js vs (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs) h coeffs qs choice
    return . fst . maximumGroupsClassificationR arg0 . map (toResultR frep2) $ variants1

-- |
generalProcMMs
 :: 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 -> ([[[PRS]]] -> [[Double]])) -- ^ 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@.
 -> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last 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,Int,String)] -- ^ The '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 (that is the default 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
 -- Changed the arguments signing so that capital letters changed to the small ones, double ++ changed to just singular +.
 -> [Array Int Int] -- ^ Permutations data.
 -> [String]
 -> IO String
generalProcMMs wrs ks arr gs js vs h qs interactiveMM coeffs coeffsWX rs perms subs =
 case length rs of
  0 -> putStrLn (messageInfo 4) >> return ""
  1 -> putStrLn (messageInfo 5) >> do
        temp <- generalProcMs wrs ks arr gs js vs h qs coeffs coeffsWX perms subs (head rs)
        finalProc interactiveMM line temp
  _ -> do
         genVariants <- mapM (generalProcMs wrs ks arr gs js vs h qs coeffs coeffsWX perms subs) rs
         finalProc interactiveMM id . foldlI . map (map line) $ genVariants

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

-- |
finalProc :: Bool -> (a -> String) -> [a] -> IO String
finalProc bool f xss = if bool then interactivePrintResult f xss else putStrLn ts >> return ts
  where ts = concatMap (\t -> f t `mappend` newLineEnding) xss

-- |
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