-- |
-- Module      :  Main
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Inspired by: https://functional-art.org/2020/papers/Poetry-OleksandrZhabenko.pdf from the https://functional-art.org/2020/performances ;
-- Allows to rewrite the given text (usually a poetical one).

{-# OPTIONS_GHC -threaded -rtsopts #-}

{-# LANGUAGE BangPatterns #-}

module Main where

import Control.Parallel.Strategies
import qualified Data.Vector as V
import Data.List (sort)
import String.Languages.UniquenessPeriods.Vector
import Languages.UniquenessPeriods.Vector.General.Debug
import Languages.UniquenessPeriods.Vector.Properties
import Languages.UniquenessPeriods.Vector.StrictV
import Languages.UniquenessPeriods.Vector.Filters (unsafeSwapVecIWithMaxI)
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import Melodics.Ukrainian
import System.Environment
import Languages.Phonetic.Ukrainian.PrepareText
import Languages.UniquenessPeriods.Vector.Data
import Languages.UniquenessPeriods.Vector.Auxiliary
import GHC.Float (int2Float)
import Data.Char (isDigit)

-- | The function allows to rewrite the Ukrainian text in the file given as the first command line argument to a new file. In between, it is rewritten
-- so that every last word on the lines is preserved at theirs position, and the rest of the line is rearranged using the specified other command line
-- arguments. They are general for the whole program. The further command line arguments are: the number of the intervals and the numbers of the intervals
-- that are swapped with the maximum one so that they are available for further usage by the program. See documentation for @uniqueness-periods-vector-filters@
-- package
-- https://hackage.haskell.org/package/uniqueness-periods-vector-filters
--
main :: IO ()
main = do
  args <- getArgs
  let !numericArgs = filter (all isDigit) . drop 1 $ args
      !numberI = fromMaybe 1 $ (readMaybe (concat . take 1 $ numericArgs)::Maybe Int)
      !file = concat . take 1 $ args
  contents <- readFile file
  let !flines = prepareText contents
      !lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines
  if compare numberI 2 == LT then do
    let !zs = if compare (length . words . concat . take 1 $ flines) 3 == LT then concat . take 1 $ flines else lastFrom3 . headU2 . fst . get22 .
               uniqNProperties2GN " 01-" (PA [] (concat . take 1 $ lasts)) 1 1 (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) . unwords . init . words . concat . take 1 $ flines
    toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2 (concat . take 1 $ lasts) [] . drop 1 $ flines))
  else do
    let !intervalNmbrs = (\vs -> if null vs then V.singleton numberI else V.uniq . V.fromList $ vs) . sort . filter (<= numberI) .
           map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ numericArgs
        !us = words . concat . take 1 $ flines
        !xs = if compare (length us) 2 == LT then [] else unwords . init $ us
        (!maxE,!minE) = runEval ((parTuple2 rpar rpar) ((\k -> if k == 0 then 1.0 else int2Float k) . (\rs -> if null rs then 0 else head rs) . firstFrom3 .
          maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" .
            aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) $ xs), (\k -> if k == 0 then 1.0 else int2Float k) . abs . (\rs -> if null rs then 0 else head rs) .
              firstFrom3 . maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty))
                (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . negate . diverse2) $ xs)))
        !zs = if compare (length . words . concat . take 1 $ flines) 3 == LT then concat . take 1 $ flines else lastFrom3 . headU2 . fst . get22 .
          uniqNProperties2GN " 01-" (PA [] (concat . take 1 $ lasts)) 1 1 (V.singleton (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs .
            oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . int2Float . diverse2) .
               unwords . init . words . concat . take 1 $ flines
    toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2I (concat . take 1 $ lasts) [] numberI intervalNmbrs minE maxE . drop 1 $ flines))

-- | Processment without rearrangements.
circle2 :: String -> [String] -> [String] -> [String]
circle2 xs yss xss
 | null xss = yss
 | otherwise = circle2 (if null rs then [] else last rs) (ws:yss) tss
      where (!zss,!tss) = splitAt 1 xss
            !rs = words . concat $ zss
            !ws = if compare (length rs) 3 == LT then unwords (xs:rs) else lastFrom3 . headU2 . fst . get22 .
                    uniqNProperties2GN " 01-" (PA xs (if null rs then [] else last rs)) 1 1 (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" .
                     aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) . unwords . init $ rs

-- | Processment with rearrangements.
circle2I :: String -> [String] -> Int -> V.Vector Int -> Float -> Float -> [String] -> [String]
circle2I xs yss numberI vI minE maxE xss
 | null xss = yss
 | otherwise = circle2I (if null rs then [] else last rs) (ws:yss) numberI vI minE maxE tss
      where (!zss,!tss) = splitAt 1 xss
            !rs = words . concat $ zss
            !ws = if compare (length rs) 3 == LT then unwords (xs:rs) else lastFrom3 . headU2 . fst . get22 .
                    uniqNProperties2GN " 01-" (PA xs (if null rs then [] else last rs)) 1 1 (V.singleton (unsafeSwapVecIWithMaxI minE maxE numberI vI .
                      oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . int2Float . diverse2) .
                        unwords . init $ rs

headU2 :: [UniquenessG1 a b] -> UniquenessG1 a b
headU2 zs
 | null zs = ([],V.empty,[])
 | otherwise = head zs
{-# INLINE headU2 #-}

noDoubleWords :: [String] -> [String]
noDoubleWords xss = map (unwords . drop 1 . words) xss
{-# INLINE noDoubleWords #-}