{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}

-- |
-- Module      :  Phonetic.Languages.General.Lines.Parsing
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- 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 poetic one).

module Phonetic.Languages.General.Lines.Parsing where

import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import System.Environment (getArgs)
import Data.Char (isDigit)
import Phonetic.Languages.General.Common
import Phonetic.Languages.General.Lines
import Data.Phonetic.Languages.PrepareText
import Phonetic.Languages.General.Lines
import Data.List (sort)
import GHC.Arr
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
import Data.Phonetic.Languages.SpecificationsRead
import Phonetic.Languages.General.Simple.Parsing

-- | The function allows to rewrite the phonetic language 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 its position, and the rest of the line is rearranged using the specified other command line
-- arguments. They are general for the whole program. The first command line argument is a 'FilePath' to the file with a phonetic text to be rewritten.
-- The second one is a variant of the \"properties\" used to evaluate the variants.
-- 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'
--
-- (Taken from the https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.4.1.0/docs/Phonetic-Languages-Lines.html
-- from the @phonetic-languages-simplified-examples-array@ package) You can also run program in a \'comparative\' mode by specifying \"+C\" as one of the command line arguments and then
-- three files -- the first two -- the existing ones with probably rewritten text by the program for different arguments
-- and the third one is the resulting file. While running in such a mode the program outputs line-by-line the contents of
-- the two first files and writes one of them (or an empty line if neither one) to the third file.
argsToLinePrepare
 :: (Double -> String -> ([[[PRS]]] -> [[Double]])) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most
  -- exact one and, therefore, the default one.
 -> IO ()
argsToLinePrepare :: (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]] -> IO ()
argsToLinePrepare Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs = do
 [String]
args00 <- IO [String]
getArgs
 let coeffs :: Coeffs2
coeffs = String -> Coeffs2
readCF (String -> Coeffs2) -> ([String] -> String) -> [String] -> Coeffs2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> Coeffs2) -> [String] -> Coeffs2
forall a b. (a -> b) -> a -> b
$ [String]
args00 -- The first command line argument. If not sure, pass just \"1_\".
     compare2 :: Bool
compare2 = (\[String]
xs -> if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs then Bool
False else Bool
True) ([String] -> Bool) -> ([String] -> [String]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+c") ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ [String]
args00
 if Bool
compare2 then do
   let args1 :: [String]
args1 = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
xs -> String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+c" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+g") [String]
args00
       [String
file1, String
file2, String
file3] = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
3 [String]
args1
   if String
file3 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
file1 Bool -> Bool -> Bool
&& String
file3 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
file2 then String -> String -> String -> IO ()
compareFilesToOneCommon String
file1 String
file2 String
file3
   else do
    String -> IO ()
putStrLn String
"You specified some files twice being in the comparative mode, the program has no well-defined behaviour in such a mode. "
    String -> IO ()
putStrLn String
"Please, run it again and specify the three different arguments with the first two being the existing files. "
 else do
  let growing :: [String]
growing = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+g") (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2)) [String]
args00
      (Int
gr1,Int
gr2)
            | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
growing = (Int
0,Int
0)
            | Bool
otherwise = let ([String]
nms,[String]
mms) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([String] -> ([String], [String]))
-> ([String] -> [String]) -> [String] -> ([String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
4 ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ [String]
growing
                              nm :: Maybe Int
nm = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
nms)::Maybe Int
                              mm :: Maybe Int
mm = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
mms)::Maybe Int in case (Maybe Int
nm,Maybe Int
mm) of
                                  (Just Int
n4,Just Int
m4) -> if (Int
m4 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
7) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
n4 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
7) then (Int
n4 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
m4 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) else (Int
0,Int
0)
                                  (Maybe Int, Maybe Int)
_ -> (Int
0,Int
0)
      args0 :: [String]
args0 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
5 [String]
args00
      [String
fileGWrSys, String
controlFile, String
segmentRulesFile, String
concatenationsFileP] = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
5 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
args00 -- To get the valid 'Concatenations' data.
  (GWritingSystemPRPLX
wrs, [(Char, Char)]
ks, CharPhoneticClassification
arr, SegmentRulesG
gs, String
js, String
vs, Concatenations
ysss, String
xs, [String]
numericArgs, String
choice, Int
numberI, String
file) <- String
-> String
-> String
-> String
-> [String]
-> IO
     (GWritingSystemPRPLX, [(Char, Char)], CharPhoneticClassification,
      SegmentRulesG, String, String, Concatenations, String, [String],
      String, Int, String)
files4Processment String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP [String]
args0
  (Int, Int)
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> Concatenations
-> String
-> String
-> String
-> Coeffs2
-> [String]
-> String
-> Int
-> String
-> IO ()
generalProcessment (Int
gr1,Int
gr2) GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs Concatenations
ysss String
xs String
js String
vs {- the old arguments afterwards -} Coeffs2
coeffs [String]
numericArgs String
choice Int
numberI String
file

-- | Is used internally in the 'argsToLinePrepare'. Nevertheless, can be used independently if the semantics
-- of the arguments and their structure are preserved.
files4Processment
  :: FilePath -- ^ With the 'GWritingSystemPRPLX' specifications only (see the gwrsysExample.txt file in the @phonetic-languages-phonetics-basics@ package as a schema);
  -> FilePath -- ^ With the 5 meaningful lines that are delimited with the \'~\' line one from another with the specifications for the possible allophones (if any), 'CharPhoneticClassification', white spaces information (two 'String's) and the 'String' of all the possible 'PLL' 'Char's;
  -> FilePath -- ^ With the 'SegmentRulesG' specifications only;
  -> FilePath -- ^ With the 'Concatenations' specifications only (see the data in the EnglishConcatenated.txt file in the @phonetic-languages-phonetics-basics@ package as a list of English equivalents of the needed 'String's).
  -> [String] -- ^ List of other command line arguments
  -> IO (GWritingSystemPRPLX, [(Char, Char)], CharPhoneticClassification, SegmentRulesG, String, String, Concatenations, String, [String], String, Int, FilePath)
files4Processment :: String
-> String
-> String
-> String
-> [String]
-> IO
     (GWritingSystemPRPLX, [(Char, Char)], CharPhoneticClassification,
      SegmentRulesG, String, String, Concatenations, String, [String],
      String, Int, String)
files4Processment String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP [String]
args0 = do
  [String
controlConts, String
gwrsCnts, String
segmentData, String
concatenationsFile] <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
readFile [String
controlFile, String
fileGWrSys, String
segmentRulesFile, String
concatenationsFileP]
  let !numericArgs :: [String]
numericArgs = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
args0
      !choice :: String
choice = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args0
      !numberI :: Int
numberI = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
numericArgs)::Maybe Int)
      !file :: String
file = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args0
      (GWritingSystemPRPLX
wrs, [(Char, Char)]
ks, CharPhoneticClassification
arr, SegmentRulesG
gs, String
js, String
vs, Concatenations
ysss, String
xs) = String
-> String
-> String
-> String
-> (GWritingSystemPRPLX, [(Char, Char)],
    CharPhoneticClassification, SegmentRulesG, String, String,
    Concatenations, String)
innerProcessmentSimple String
gwrsCnts String
controlConts String
segmentData String
concatenationsFile
        in (GWritingSystemPRPLX, [(Char, Char)], CharPhoneticClassification,
 SegmentRulesG, String, String, Concatenations, String, [String],
 String, Int, String)
-> IO
     (GWritingSystemPRPLX, [(Char, Char)], CharPhoneticClassification,
      SegmentRulesG, String, String, Concatenations, String, [String],
      String, Int, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (GWritingSystemPRPLX
wrs, [(Char, Char)]
ks, CharPhoneticClassification
arr, SegmentRulesG
gs, String
js, String
vs, Concatenations
ysss, String
xs, [String]
numericArgs, String
choice, Int
numberI, String
file)