-- |
-- Module      :  Main
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Analyzes a poetic text in Ukrainian, for every line prints statistic data and
-- then for the whole poem prints the hypothesis evaluation information.
--
-- To enable parallel computations (potentially, they can speed up the work), please, run the @propertiesText@ executable with
-- @+RTS -threaded -RTS@ command line options with possibly @-N@ option inside.
--

{-# OPTIONS_GHC -threaded -rtsopts #-}

{-# LANGUAGE BangPatterns, FlexibleContexts #-}

module Main where


import Data.SubG
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 qualified Data.Vector as VB
import Languages.UniquenessPeriods.Vector.General.Simplified
import Languages.UniquenessPeriods.Vector.General.DebugG hiding (newLineEnding,maximumElBy)
import Languages.UniquenessPeriods.Vector.PropertiesG
import Languages.UniquenessPeriods.Vector.PropertiesFuncRepG
import Languages.UniquenessPeriods.Vector.PropertiesSyllablesG
import Melodics.ByteString.Ukrainian
import System.Environment
import Languages.Phonetic.Ukrainian.PrepareText
import Languages.UniquenessPeriods.Vector.DataG
import Languages.UniquenessPeriods.Vector.AuxiliaryG
import Languages.UniquenessPeriods.Vector.StrictVG
import Numeric (showFFloat)
import Languages.UniquenessPeriods.Vector.Filters
import Data.Char (isAlpha)
import Data.Statistics.RulesIntervals
import Languages.UniquenessPeriods.Vector.FuncRepRelatedG


main :: IO ()
main = do
 args0 <- getArgs
 let args = filter (\xs -> all (/= ':') xs && all (/= '@') xs) args0
     !coeffs = readCF . concat . take 1 $ args -- The first command line argument. If not sure, just enter \"1_\".
     !lInes = filter (any (== ':')) args0
     !numbersJustPrint =  filter (== "@n") args0
 if isPair coeffs then do
  let !file = concat . drop 1 . take 2 $ args  -- The second command line argument except those ones that are RTS arguments
  if null numbersJustPrint then do
   let !gzS = concat . take 1 . drop 2 $ args -- The third command line argument that controls the choice of the number of intervals
       !printLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 3 $ args)::(Maybe Int)) -- The fourth command line argument except those ones that are  RTS arguments. Set to 1 if you would like to print the current line within the information
       !toOneLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 4 $ args)::(Maybe Int)) -- The fifth command line argument except those ones that are RTS arguments. Set to 1 if you would like to convert the text into one single line before applying to it the processment (it can be more conceptually consistent in such a case)
       !choice = concat . drop 5 . take 6 $ args -- The sixth command line argument that controls what properties are used.
   generalProc lInes coeffs file gzS printLine toOneLine choice
  else do
   contents <- readFile file
   fLinesIO contents
 else do
  let !file = concat . take 1 $ args
  if null numbersJustPrint then do
   let !gzS = concat . take 1 . drop 1 $ args
       !printLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 2 $ args)::(Maybe Int))
       !toOneLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 3 $ args)::(Maybe Int))
       !choice = concat . drop 4 . take 5 $ args
   generalProc lInes coeffs file gzS printLine toOneLine choice
  else do
   contents <- readFile file
   fLinesIO contents

generalProc :: [String] -> Coeffs2 -> FilePath -> String -> Int -> Int -> String -> IO ()
generalProc lInes coeffs file gzS printLine toOneLine choice
 | null lInes = do
    contents <- readFile file
    let !flines = fLines toOneLine contents
    getData3 coeffs (getIntervalsN gzS flines) printLine choice flines
 | otherwise = do
    contents <- readFile file
    let flines = fLines toOneLine . unlines . linesFromArgsG lInes . map VB.toList . fLines 0 $ contents
    getData3 coeffs (getIntervalsN gzS flines) printLine choice 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

getIntervalsN :: String -> [VB.Vector Char] -> Int
getIntervalsN xs ys
  | xs == "s" = sturgesH (length ys)
  | xs == "l" = levynskyiMod (length ys)
  | otherwise = fromMaybe 9 (readMaybe xs::(Maybe Int))
{-# INLINE getIntervalsN #-}

getData3 :: Coeffs2 -> Int -> Int -> String -> [VB.Vector Char] -> IO ()
getData3 coeffs gz printLine choice zs = let !permsV4 = genPermutationsV in mapM_ (process1Line coeffs gz printLine choice permsV4) zs

process1Line :: Coeffs2 -> Int -> Int -> String -> VB.Vector (VB.Vector (VB.Vector Int)) -> VB.Vector Char -> IO ()
process1Line coeffs gz printLine choice !permsV5 v = bracket (do
 myThread <- forkIO (do
   let !whspss = VB.fromList " 01-"
       !v2 = subG whspss v
       !l2 = (subtract 2) . VB.length $ v2
       (!maxE,!minE,!data2)
          | compare l2 0 /= LT = runEval (parTuple3 rpar rpar rpar ((\k -> if k == 0.0 then 1.0 else k) . (\ls -> if null ls then 0.0 else head ls) .
              firstFrom3 . maximumElBy 1 (VB.singleton oneProperty) .
                uniquenessVariants2GNB ' ' id id id (VB.unsafeIndex permsV5 l2) (VB.singleton oneProperty) (chooseMax coeffs choice) $ v2,
                  (\k -> if k == 0.0 then 1.0 else k) . abs . (\ls -> if null ls then 0.0 else head ls) .
                     firstFrom3 . maximumElBy 1 (VB.singleton oneProperty) .
                       uniquenessVariants2GNB ' ' id id id (VB.unsafeIndex permsV5 l2) (VB.singleton oneProperty) (chooseMin coeffs choice) $ v2,
                         (\k -> if k == 0.0 then 1.0 else k) . head . getAC (chooseMax coeffs choice) $ v))
          | otherwise = let !mono = (\k -> if k == 0.0 then 1.0 else k) . head . getAC (chooseMax coeffs choice) $ v in (mono,mono,mono)
       (!wordsN,!intervalN)
         | maxE == 1.0 = (0, 0)
         | otherwise = runEval (parTuple2 rpar rpar (l2 + 2, intervalNRealFrac minE maxE gz data2))
       !ratio = if maxE == 1.0 then 0.0 else 2.0 * data2 / (minE + maxE) in do
         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 Nothing ratio $ "\t"
         hPutStr stdout ('\t':show (wordsN::Int))
         hPutStr stdout ('\t':show (intervalN::Int))
         hPutStrLn stdout (if printLine == 1 then '\t':(VB.toList v) else ""))
 return myThread) (killThread) (\_ -> putStr "")

fLines :: Int -> String -> [VB.Vector Char]
fLines !toOneLine ys =
  let preText = filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareText . (\z -> if toOneLine == 1 then unwords . words $ z else z) $ ys
      wss = map (length . subG " 01-") preText
      g (t:ts) (r:rs) = if r > 7 then filter (`notElem` "01-") t:g ts rs else t:g ts rs
      g _ _ = []
        in map VB.fromList . g preText $ wss

fLinesIO :: String -> IO ()
fLinesIO ys =
  let preText = filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareText $ ys
      wss = map (length . subG " 01-") preText
      g (t:ts) (r:rs) = if r > 7 then filter (`notElem` "01-") t:g ts rs else t:g ts rs
      g _ _ = []
        in VB.mapM_ putStrLn . VB.map (\(i,x) -> show (i + 1) ++ "\t" ++ x) . VB.indexed . VB.fromList . g preText $ wss