{-# LANGUAGE NoImplicitPrelude #-}

module Phladiprelio.General.Simple where

import GHC.Base
import GHC.Enum (fromEnum)
import GHC.Real (fromIntegral,(/))
import Text.Show (show)
import Phladiprelio.General.PrepareText 
import Phladiprelio.General.Syllables 
import Phladiprelio.General.Base
import System.Environment (getArgs)
import GHC.Num ((+),(-),(*))
import Text.Read (readMaybe)
import System.IO (putStrLn, FilePath,stdout,universalNewlineMode,hSetNewlineMode)
import Rhythmicity.MarkerSeqs hiding (id) 
import Rhythmicity.BasicF 
import Data.List hiding (foldr)
import Data.Maybe (fromMaybe, mapMaybe, catMaybes) 
import Data.Tuple (fst,snd)
import CLI.Arguments
import CLI.Arguments.Get
import CLI.Arguments.Parsing
import GHC.Int (Int8)
import Data.Ord (comparing)
import Phladiprelio.PermutationsRepresent
import Phladiprelio.ConstraintsEncoded
import Phladiprelio.PermutationsArr
import Phladiprelio.StrictVG

generalF 
 :: 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
 -> SegmentRulesG
 -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> ([[[PRS]]] -> [[Double]])
 -> Int
 -> HashCorrections 
 -> (Int8,[Int8])
 -> Bool
 -> Int -- ^ The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12. 
 -> [String] 
 -> IO [()] 
generalF wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep universalSet = do
   let syllN = countSyll wrs arr us vs . concat . take 1  $ universalSet
--       universalSet = map unwords . permutations $ rss
       f grps mxms = sum . countHashes2G hashStep hc grps mxms . mconcat . h . createSyllablesPL wrs ks arr gs us vs
   if numTest `elem` 0:[2..9] then do
      hSetNewlineMode stdout universalNewlineMode
      putStrLn "Feet   Val  Stat   Proxim" 
      mapM (\(q,qs) -> let m = stat1 syllN (q,qs) in let max1 = maximumBy (comparing (f q qs)) universalSet in let mx = f q qs max1 in putStrLn (show (fromEnum q) `mappend` "   |   " `mappend`  show mx `mappend` "     " `mappend` show m `mappend` "  -> " `mappend` show (100 * fromIntegral mx / fromIntegral m) `mappend` "%" `mappend` (if numTest >= 4 then let min1 = minimumBy (comparing (f q qs)) universalSet in ("\n" `mappend` min1 `mappend` "\n" `mappend` max1 `mappend` "\n")  else ""))) . zip [2..7] $ (sel numTest)
   else mapM (\(x,y) -> putStrLn (show x `mappend` (' ':y)))  . (let h1 (u,w) = if descending then ((-1)*u,w) else (u,w) in sortOn h1) . map (\xss -> (f grps mxms xss, xss)) $ universalSet
      where sel x 
              | x == 0 || x == 4 = [[1],[2,1],[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]]
              | x == 2 || x == 5 = [[1],[2],[3],[4,3],[5,4],[6,5,4]]
              | x == 7 = [[0],[1,0],[1,0],[1,0],[1,0],[1,0]]
              | x == 8 = [[0],[1,0],[1,0],[2,1,0],[2,1,0],[2,1,0]]
              | x == 9 = [[0],[1,0],[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]]
              | otherwise = [[1],[2,1],[3,2,1],[3,2],[4,3,2]]

countSyll 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> CharPhoneticClassification 
  ->  String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> Int
countSyll wrs arr us vs xs = fromEnum . foldr (\x y -> if createsSyllable x then y + 1 else y) 0 . concatMap (str2PRSs arr) . words1 . mapMaybe g . concatMap string1 . stringToXG wrs $ xs
   where g :: Char -> Maybe Char
         g x
          | x `elem` us = Nothing
          | x `notElem` vs = Just x
          | otherwise = Just ' '
         words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
           where ts = dropWhile (== ' ') xs
                 (w, s'') = break (== ' ') ts
         {-# NOINLINE words1 #-}

stat1 :: Int -> (Int8,[Int8]) -> Int
stat1 n (k, ks) = fst (n `quotRemInt` fromEnum k) * length ks

processingF
 :: 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
 -> SegmentRulesG
 -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
 -> ([[[PRS]]] -> [[Double]])
 -> Int
 -> HashCorrections 
 -> (Int8,[Int8]) 
 -> [[String]] 
 -> [[String]] 
 -> Bool
 -> Int -- ^ The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12. 
 -> String 
 -> IO ()
processingF wrs ks arr gs us vs h numTest hc (grps,mxms) ysss zsss descending hashStep xs = do
  args0 <- getArgs
  let (argsC, args) = takeCs1R ('+','-') cSpecs args0
      prepare = any (== "-p") args
      argCs = catMaybes (fmap (readMaybeECG (l - 1)) -- . (showB l lstW2:)
                                                    . getC "+a" $ argsC)
      ll = take 7 . (if prepare then id else words . mconcat . prepareText ysss zsss xs . unwords) $ args
      l = length ll
      perms 
        | null argCs = genPermutationsL l
        | otherwise = decodeLConstraints argCs . genPermutationsL $ l 
      variants1 = uniquenessVariants2GNBL ' ' id id id perms ll
  generalF wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep variants1 >> return ()

-- | Specifies the group of the command line arguments for 'processingF', which specifies the
-- PhLADiPreLiO constraints. For more information, see:
-- https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#constraints 
cSpecs :: CLSpecifications
cSpecs = [("+a",-1)]