-- |
-- Module      :  Main
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Prints the rearrangements with the \"property\" information for the Ukrainian language text.

{-# OPTIONS_GHC -threaded -rtsopts #-}

module Main where

import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2
import System.Environment (getArgs)
import Phonetic.Languages.Simple
import Interpreter.StringConversion (readFileIfAny)
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import CLI.Arguments
import CLI.Arguments.Parsing
import CLI.Arguments.Get
import Phonetic.Languages.Permutations.Represent

-- | Prints the rearrangements with the \"property\" information for the Ukrainian language text. The first command line argument must be a
-- positive 'Int' number and is a number of printed variants for the line (if they are present, otherwise just all possible variants are printed).
-- The second one is the number of the intervals into which the all range of possible metrics values are divided. The next numeric arguments that must be
-- sequenced without interruptions further are treated as the numbers of the intervals (counting is started from 1) which values are moved to the maximum
-- values of the metrics interval using the 'unsafeSwapVecIWithMaxI' function. The first textual command line argument should be in the form either \"y0\",
-- or \"0y\", or \"yy\", or \"y\", or \"02y\", or \"y2\", or \"03y\", or \"yy2\", or \"y3\", or some other variant and specifies, which property or properties is or are evaluated.
-- The rest of the command line arguments is the Ukrainian text. Besides, you can use multiple metrices (no more than 5 different ones) together by
-- using \"+m\" ... \"-m\" command line arguments.
--
-- You can specify constraints according to the 'decodeLConstraints' function between +a and -a command line arguments. If so, the program will
-- ask you additional question before proceeding. The \"+m\" ... \"-m\" and \"+a\" ... \"-a\" groups must not mutually intersect one another.
main :: IO ()
main = do
 args50 <- getArgs
 let (cfWX,args501) = takeBsR [("+x",1)] args50
     coeffsWX = readCF . concat . getB "+x" $ cfWX -- The command line argument that starts with \"+x\".
     (argsA,argsB,argsC1,argss) = args2Args31R fstCharsMA specs1 args501
     (argsC2,arg2ss) = takeCs1R fstCharsT cSpecs1T argss
     pairwisePermutations = bTransform2Perms . getB "+p" $ argsB
     fileDu = concat . getB "+d" $ argsB
     recursiveMode = oneA "+r" argsA -- Specifies whether to use the interactive recursive mode
     lstW = listA ["+b","+bl"] argsA -- If one of the command line options is \"+b\" or \"+bl\" then the last word of the line will remain the last one.
     jstL0 = listA ["+l","+bl"] argsA -- If one of the command line options is \"+l\" or \"+bl\" then the program outputs just lines without metrices values.
     nativeUkrainian = oneA "+u" argsA -- If one of the command line options is \"+u\" then the informational messages are printed in Ukrainian, otherwise (the default behaviour) they are in English.
     toFileMode1 = concat . getB "+f" $ argsB -- Prints the last resulting line of the interactive mode processment (the last selected variant) to the file and also to the stdout.
     interactiveP = recursiveMode || oneA "+i" argsA || oneB "+f" argsB -- If one of the command line options is \"+i\", or \"+f\" then the program prints the variants and then prompts for the preferred variant. Afterwards, it prints just that variant alone.
     textProcessmentFssFs = drop 1 . getC "+t" $ argsC2
     textProcessment0
       | null . concat . getB "+t" . fst . takeBsR [("+t",1)] $ argss = []
       | otherwise = "+t" `mappend` (concat . getB "+t" . fst . takeBsR [("+t",1)] $ argss)
     textProcessment1 = fromMaybe 70 (readMaybe (drop 2 textProcessment0)::Maybe Int)
     args0 = snd . takeAsR aSpecs . snd . takeBsR [("+d",1)] $ args501
 let args = snd . takeCs1R fstCharsMA [("+m",-1)] . snd . takeBsR [("+f",1)] . snd . takeCs1R fstCharsMA [("+a",-1)] $ arg2ss
     coeffs = readCF . concat . take 1 $ args -- The first command line argument.
 textProcessmentFss0 <- mapM (readFileIfAny) textProcessmentFssFs
 let textProcessmentFss = filter (not . null) textProcessmentFss0
 if isPair coeffs then generalProc3G fileDu pairwisePermutations textProcessmentFss textProcessment0 textProcessment1 recursiveMode nativeUkrainian toFileMode1 interactiveP jstL0 args0 coeffs coeffsWX (drop 1 args) lstW
 else generalProc3G fileDu pairwisePermutations textProcessmentFss textProcessment0 textProcessment1 recursiveMode nativeUkrainian toFileMode1 interactiveP jstL0 args0 coeffs coeffsWX args lstW

aSpecs :: CLSpecifications
aSpecs = zip ["+r","+b","+l","+bl","+i","+u"] . cycle $ [0]

aSpcs :: [String] -> Args
aSpcs = fst . takeAsR aSpecs

cSpecs1MA :: CLSpecifications
cSpecs1MA = zip ["+m","+a"] . cycle $ [-1]

fstCharsMA :: FirstChars
fstCharsMA = ('+','-')

cSpecs1T :: CLSpecifications
cSpecs1T = [("+t",-1)]

fstCharsT :: FirstChars
fstCharsT = ('+','^')

bSpecs :: CLSpecifications
bSpecs = zip ["+d","+f","+p"] . cycle $ [1]

bSpcs :: [String] -> Args
bSpcs = fst . takeBsR bSpecs

specs1 :: CLSpecifications
specs1 = aSpecs `mappend` bSpecs `mappend` cSpecs1MA