{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}

module Phladiprelio.Ukrainian.IO where

import GHC.Arr
import GHC.Base
import GHC.Num (Integer,(+),(-),(*))
import GHC.Real (fromIntegral,(/),quot,rem,quotRem)
import GHC.Enum (fromEnum,toEnum)
import Text.Show (Show(..))
import Text.Read (readMaybe)
import Data.Char (isDigit, isAlpha,toLower)
import System.IO (putStrLn, FilePath,stdout,hSetNewlineMode,universalNewlineMode,getLine,appendFile,print,writeFile)
import Rhythmicity.MarkerSeqs hiding (id) 
import Data.List hiding (foldr)
import Data.Maybe (isNothing,fromJust) 
import Data.Tuple (fst,snd)
import Phladiprelio.Ukrainian.Syllable 
import Phladiprelio.Ukrainian.SyllableDouble
import Phladiprelio.Ukrainian.Melodics 
import GHC.Int (Int8)
import CaseBi.Arr (getBFst')
import Phladiprelio.Ukrainian.ReadDurations
import Data.Ord (comparing)
import Numeric (showFFloat)
import Phladiprelio.Halfsplit
import System.Directory (readable,writable,getPermissions,Permissions(..),doesFileExist,getCurrentDirectory)
import Data.ReversedScientific
import Control.Concurrent.Async (mapConcurrently)
import Phladiprelio.Tests
import Phladiprelio.General.Datatype (readBasic3, readBasic4, readBasic1G)
import Phladiprelio.UniquenessPeriodsG

generalF
 :: Bool -- ^ If 'True' then adds \"<br>\" to line endings for double column output
 -> FilePath -- ^ A path to the file to save double columns output to. If empty then just prints to 'stdout'.
 -> String -- ^ If not null than instead of rhythmicity evaluation using hashes and and feets, there is computed a diversity property for the specified 'String' here using the 'selectSounds' function. For more information, see: 'https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types'
 -> (String, String)  -- ^ If the next element is not equal to -1, then the prepending and appending lines to be displayed. Used basically for working with the multiline textual input data.
 -> Int -- ^ The number of the line in the file to be read the lines from. If equal to -1 then neither reading from the file is done nor the first argument influences the processment results.
 -> FilePath -- ^ The file to read the sound representation durations from.
 -> Int 
 -> HashCorrections 
 -> (Int8,[Int8]) 
 -> Int 
 -> Bool 
 -> Int 
 -> Bool 
 -> Int8 
 -> (FilePath, Int) 
 -> Bool  -- ^ Whether to run tests concurrently or not. 'True' corresponds to concurrent execution that can speed up the getting results but use more resources.
 -> String -- ^ An initial string to be analysed.
 -> [String] 
 -> IO [String]
generalF html dcfile selStr (prestr, poststr) lineNmb file numTest hc (grps,mxms) k descending hashStep emptyline splitting (fs,code) concurrently initstr universalSet@(u1:u2:us) = do
   syllableDurationsDs <- readSyllableDurations file
   let syllN = countSyll initstr
--       universalSet = map unwords . permutations . words $ rs
       f syllableDurationsDs grps mxms -- Since the version 0.12.0.0, has a possibility to evaluate diversity property.
            | null selStr = sum . countHashes2G hashStep hc grps mxms . readBasic3 ((if null file then case k of { 1 -> syllableDurationsD; 2 -> syllableDurationsD2; 3 -> syllableDurationsD3; 4 -> syllableDurationsD4} 
                         else  if length syllableDurationsDs >= k then syllableDurationsDs !! (k - 1) else syllableDurationsD2) . createSyllablesUkrS) (mconcat) 
            | otherwise = fromIntegral . diverse2GGL (selectSounds selStr) [100,101] . convertToProperUkrainianI8 . filter (\c -> not (isDigit c) && c /= '_')
   hSetNewlineMode stdout universalNewlineMode
   if numTest >= 0 && numTest <= 179 && numTest /= 1 then do
     putStrLn "Feet   Val  Stat   Proxim" 
     (if concurrently 
          then mapConcurrently
          else mapM) (\(q,qs) -> 
                          let m = stat1 syllN (q,qs)
                              (min1, max1) = minMax11ByCList (comparing (f syllableDurationsDs q qs)) universalSet 
                              mx = f syllableDurationsDs q qs max1 
                              strTest = (show (fromEnum q) `mappend` "   |   " `mappend`  show mx `mappend` "     " `mappend` show m `mappend` "  -> " `mappend` 
                                  showFFloat (Just 3) (100 * fromIntegral mx / fromIntegral m) "%" `mappend` (if rem numTest 10 >= 4 
                                                                                                                          then ("\n" `mappend` min1 `mappend` "\n" `mappend` max1 `mappend` "\n")
                                                                                                                          else "")) in putStrLn strTest >> return strTest) . zip (sel2 numTest) $ (sel numTest)
   else let sRepresent = zipWith (\k (x, ys) -> S k x ys) [1..] . 
                   (let h1 = if descending then (\(u,w) -> ((-1) * u, w)) else id in sortOn h1) . map (\xss -> (f syllableDurationsDs grps mxms xss, xss)) $ universalSet
            strOutput = (:[]) . halfsplit1G (\(S _ y _) -> y) (if html then "<br>" else "") (jjj splitting) $ sRepresent
                        in do
                             _ <- (if null dcfile then mapM putStrLn strOutput else do {mapM putStrLn strOutput >> doesFileExist dcfile >>= \exist -> if exist then do {getPermissions dcfile >>= \perms -> if writable perms then mapM (writeFile dcfile) strOutput else error $ "Phladiprelio.Ukrainian.IO.generalF: File " `mappend` dcfile `mappend` " is not writable!"} else do {getCurrentDirectory >>= \currdir -> do {getPermissions currdir >>= \perms -> if writable perms then mapM (writeFile dcfile) strOutput else error $ "Phladiprelio.Ukrainian.IO.generalF: Directory of the file " `mappend` dcfile `mappend` " is not writable!"}}})
                             let l1 = length sRepresent
                             if code == -1 
                                 then if lineNmb == -1 then return strOutput
                                      else do 
                                          print23 prestr poststr 1 [initstr]
                                          return strOutput
                                 else do 
                                       print23 prestr poststr 1 [initstr]
                                       parseLineNumber l1 >>= \num -> do
                                         permiss <- getPermissions fs
                                         let writ = writable permiss
                                             readab = readable permiss
                                         if writ && readab then do
                                             if null selStr then do
                                                let lineOption = head . filter (\(S k _ ts) -> k == num) $ sRepresent
                                                    textP = (\(S _ _ ts) -> ts) lineOption
                                                    sylls = createSyllablesUkrS textP
                                                if code >= 10 && code <= 19 && grps == 2
                                                    then do
                                                        let qqs = readBasic4 ((if null file then case k of { 1 -> syllableDurationsD; 2 -> syllableDurationsD2; 3 ->
       syllableDurationsD3; 4 -> syllableDurationsD4} else if length syllableDurationsDs >= k then syllableDurationsDs !! (k - 1) else syllableDurationsD2) . createSyllablesUkrS) (mconcat) (mconcat . createSyllablesUkrS) (map showFS) . readBasic1G $ textP 
                                                            (breaks, rs) = showZerosFor2PeriodMusic qqs
                                                        putStrLn textP
                                                        putStrLn breaks
                                                        putStrLn . show $ rs
                                                        appendFile fs ((if code >= 15 then (show rs `mappend` "\n" `mappend` breaks `mappend` "\n") else "") `mappend` outputSel lineOption code)
                                                    else appendFile fs (outputSel lineOption code)
                                             else do 
                                                let lineOption = head . filter (\(S k _ ts) -> k == num) $ sRepresent
                                                appendFile fs (outputSel lineOption code)
                                         else error "The specified file cannot be used for appending the text! Please, specify another file!"
                                         return []
          where jjj kk = let (q1,r1) = quotRem kk (if kk < 0 then -10 else 10) in jjj' q1 r1 emptyline
                jjj' q1 r1 emptyline
                  | r1 == (-1) || r1 == (-3) = -10*q1 + (if emptyline then -5 else r1)
                  | r1 == 1 || r1 == 3 = 10*q1 + (if emptyline then 5 else r1)
                  | r1 < 0 = -10*q1 + (if emptyline then -4 else r1)
                  | otherwise = 10*q1 + (if emptyline then 4 else r1)
generalF _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ [u1] = mapM putStrLn [u1] >> return [u1]
generalF _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = let strOutput = ["You have specified the data and constraints on it that lead to no further possible options.", "Please, specify another data and constraints."] in mapM putStrLn strOutput >> return strOutput

data PhladiprelioUkr = S Int Integer String deriving Eq

instance Show PhladiprelioUkr where
  show (S i j xs) = showBignum 7 j `mappend` " " `mappend` xs `mappend` "  " `mappend` showWithSpaces 4 i

countSyll :: String -> Int
countSyll xs = fromEnum . foldr (\x y -> if isVowel1 x then y + 1 else y) 0 . convertToProperUkrainianI8 $ xs

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

parseHelp :: [String] -> (String,[String])
parseHelp xss 
  | null xss = ([],[])
  | otherwise = (unwords rss, uss `mappend` qss)
       where (yss,tss) = break (== "-b") xss
             (uss,wss) = break (== "+b") yss
             [qss,rss] = map (drop 1) [tss, wss]
             
outputSel :: PhladiprelioUkr -> Int -> String
outputSel (S x1 y1 ts) code
  | code < 0 = []
  | code == 1 || code == 11 || code == 16 = intercalate " " [show x1, ts] `mappend` "\n"
  | code == 2 || code == 12 || code == 17 = intercalate " " [show y1, ts] `mappend` "\n"
  | code == 3 || code == 13 || code == 18 = intercalate " " [show x1, ts, show y1] `mappend` "\n"
  | code == 4 || code == 14 || code == 19 = intercalate " " [show x1, show y1] `mappend` "\n"
  | otherwise = ts `mappend` "\n"

parseLineNumber :: Int -> IO Int
parseLineNumber l1 = do 
  putStrLn "Please, specify the number of the option to be written to the file specified: "
  number <- getLine
  let num = readMaybe (filter isDigit number)::Maybe Int
  if isNothing num || num > Just l1 || num == Just 0 
      then parseLineNumber l1 
      else return . fromJust $ num

{-| 'selectSounds' converts the argument after \"+ul\" command line argument into a list of  Ukrainian sound representations that is used for evaluation of \'uniqueness periods\' properties of the line. Is a modified Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.parsey0Choice from the @phonetic-languages-simplified-examples-array-0.21.0.0@ package. 
-}
selectSounds :: String -> FlowSound
selectSounds = f . sort . filter (/= 101) . concatMap g . words . map (\c -> if c  == '.' then ' ' else toLower c)
    where g = getBFst' ([101::Sound8], listArray (0,41) (("1",[1,2,3,4,5,6,7,8,10,15,17,19,21,23,25,27,28,30,32,34,36,38,39,41,43,45,47,49,50,52,54,66]):("sr",[27,28,30,32,34,36]):("vd",[8,10,15,17,19,21,23,25]) :("vs",[45,47,49,50,43,52,38,66,54,39,41]) :("vw",[1..6]) :map (\(k,t) -> (k,[t])) [("\1072",1),("\1073",15),("\1074",36),("\1075",21),("\1076",17),("\1076\1078",23),("\1076\1079",8),("\1077",2),("\1078",10),("\1079",25),("\1080",5),("\1081",27),("\1082",45),("\1083",28),("\1084",30),("\1085",32),("\1086",3),("\1087",47),("\1088",34),("\1089",49),("\1089\1100",54),("\1090",50),("\1091",4),("\1092",43),("\1093",52),("\1094",38),("\1094\1100",66),("\1095",39),("\1096",41),("\1097",55),("\1100",7),("\1102",56),("\1103",57),("\1108",58),("\1110",6),("\1111",59),("\1169",19),("\8217",61)]))
          f (x:ts@(y:xs)) 
            | x == y = f ts
            | otherwise = x:f ts
          f xs = xs