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

-- |
-- Module      :  Phonetic.Languages.General.Lines.Parsing
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- 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.Lines
import Data.Phonetic.Languages.PrepareText
import Data.List (nub)
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
import Phonetic.Languages.General.Simple.Parsing (innerProcessmentSimple)
import CLI.Arguments
import CLI.Arguments.Parsing
import CLI.Arguments.Get
import qualified Phonetic.Languages.Permutations.Represent as R
import Phonetic.Languages.Coeffs

-- | 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.
--
-- @ since 0.12.0.0
-- You can run the comparative mode on the up to 7 different files simultaneously.
-- Besides, there is also a multiple properties mode.
argsToLinePrepare
 :: (Double -> String -> MappingFunctionPL) -- ^ 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@.
 -> [MappingFunctionPL] -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> (String -> String)  -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
 -> IO ()
argsToLinePrepare :: (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL] -> (String -> String) -> IO ()
argsToLinePrepare Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs String -> String
g1 = do
 [String]
args50 <- IO [String]
getArgs
 let (Args
argsA,Args
argsB,Args
argsC1,[String]
_) = FirstChars
-> CLSpecifications -> [String] -> (Args, Args, Args, [String])
args2Args31R FirstChars
fstCharsM CLSpecifications
specs1 [String]
args50
     (Args
prWP,[String]
args000) = CLSpecifications -> [String] -> (Args, [String])
takeBsR [(String
"+p",GQtyArgs
1)] [String]
args50
     pairwisePermutations :: PermutationsType
pairwisePermutations = [String] -> PermutationsType
R.bTransform2Perms forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+p" forall a b. (a -> b) -> a -> b
$ Args
prWP
     multiple :: GQtyArgs
multiple
       | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Args
argsC1 = GQtyArgs
0
       | Bool
otherwise = GQtyArgs
1
     args00 :: [String]
args00 = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstChars -> CLSpecifications -> [String] -> (Args, [String])
takeCs1R FirstChars
fstCharsM CLSpecifications
cSpecs1 forall a b. (a -> b) -> a -> b
$ [String]
args000
     coeffs :: Coeffs2
coeffs = String -> Coeffs2
readCF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 forall a b. (a -> b) -> a -> b
$ [String]
args00 -- The first command line argument. If not sure, pass just \"1_\".
     compare2 :: Bool
compare2 = forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneA String
"+c" Args
argsA
 if Bool
compare2 then do
   let args1 :: [String]
args1 = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeAsR [(String
"+c",GQtyArgs
0)] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeBsR [(String
"+g",GQtyArgs
1)] forall a b. (a -> b) -> a -> b
$ [String]
args00
       ([String]
args2,String
file3)
         | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args1 = ([],[])
         | Bool
otherwise = (forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [String]
args1,forall a. [a] -> a
last [String]
args1)
   if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
file3 then do
       String -> IO ()
putStrLn String
"Please, specify the file to save the data to. "
       String
file3 <- IO String
getLine
       [String] -> String -> IO ()
compareFilesToOneCommon [String]
args2 String
file3
   else [String] -> String -> IO ()
compareFilesToOneCommon [String]
args2 String
file3
 else do
  let growing :: String
growing = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+g" forall a b. (a -> b) -> a -> b
$ Args
argsB
      (GQtyArgs
gr1,GQtyArgs
gr2)
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
growing = (GQtyArgs
0,GQtyArgs
0)
            | Bool
otherwise = let (String
nms,String
mms) = forall a. GQtyArgs -> [a] -> ([a], [a])
splitAt GQtyArgs
1 String
growing
                              nm :: Maybe GQtyArgs
nm = forall a. Read a => String -> Maybe a
readMaybe String
nms::Maybe Int
                              mm :: Maybe GQtyArgs
mm = forall a. Read a => String -> Maybe a
readMaybe String
mms::Maybe Int in case (Maybe GQtyArgs
nm,Maybe GQtyArgs
mm) of
                                  (Just GQtyArgs
n4,Just GQtyArgs
m4) -> if (GQtyArgs
m4 forall a. Integral a => a -> a -> a
`rem` GQtyArgs
7) forall a. Ord a => a -> a -> Bool
< (GQtyArgs
n4 forall a. Integral a => a -> a -> a
`rem` GQtyArgs
7) then (GQtyArgs
n4 forall a. Integral a => a -> a -> a
`rem` GQtyArgs
7 forall a. Num a => a -> a -> a
+ GQtyArgs
1, GQtyArgs
m4 forall a. Integral a => a -> a -> a
`rem` GQtyArgs
7 forall a. Num a => a -> a -> a
+ GQtyArgs
1) else (GQtyArgs
0,GQtyArgs
0)
                                  (Maybe GQtyArgs, Maybe GQtyArgs)
_ -> (GQtyArgs
0,GQtyArgs
0)
      args0 :: [String]
args0 = forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
5 [String]
args000
      [String
fileGWrSys, String
controlFile, String
segmentRulesFile, String
concatenationsFileP, String
concatenationsFileA] = forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
6 forall a b. (a -> b) -> a -> b
$ [String]
args00 -- To get the valid 'Concatenations' data.
  (GWritingSystemPRPLX
wrs, [FirstChars]
ks, CharPhoneticClassification
arr, SegmentRulesG
gs, String
js, String
vs, Concatenations
ysss, Concatenations
zzzsss, String
xs, [String]
numericArgs, [String]
choices, GQtyArgs
numberI, String
file) <- String
-> String
-> String
-> String
-> String
-> GQtyArgs
-> [String]
-> IO
     (GWritingSystemPRPLX, [FirstChars], CharPhoneticClassification,
      SegmentRulesG, String, String, Concatenations, Concatenations,
      String, [String], [String], GQtyArgs, String)
files4Processment String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP String
concatenationsFileA GQtyArgs
multiple [String]
args0
  PermutationsType
-> (GQtyArgs, GQtyArgs)
-> GWritingSystemPRPLX
-> [FirstChars]
-> CharPhoneticClassification
-> SegmentRulesG
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> Coeffs2
-> (String -> String)
-> [String]
-> [String]
-> GQtyArgs
-> String
-> IO ()
generalProcessment PermutationsType
pairwisePermutations (GQtyArgs
gr1,GQtyArgs
gr2) GWritingSystemPRPLX
wrs [FirstChars]
ks CharPhoneticClassification
arr SegmentRulesG
gs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss String
xs String
js String
vs {- the old arguments afterwards -} Coeffs2
coeffs String -> String
g1 [String]
numericArgs [String]
choices GQtyArgs
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). These are to be prepended to the next word.
  -> 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). These are to be appended to the previous word.
  -> Int -- ^ If equal to 1, then the function is intended to be used in the multiple properties mode, else it is intended to be used in the single property mode.
  -> [String] -- ^ List of other command line arguments
  -> IO (GWritingSystemPRPLX, [(Char, Char)], CharPhoneticClassification, SegmentRulesG, String, String, Concatenations, Concatenations, String, [String], [String], Int, FilePath)
files4Processment :: String
-> String
-> String
-> String
-> String
-> GQtyArgs
-> [String]
-> IO
     (GWritingSystemPRPLX, [FirstChars], CharPhoneticClassification,
      SegmentRulesG, String, String, Concatenations, Concatenations,
      String, [String], [String], GQtyArgs, String)
files4Processment String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP String
concatenationsFileA GQtyArgs
multiple [String]
args0 = do
  [String
controlConts, String
gwrsCnts, String
segmentData, String
concatenationsFileP1, String
concatenationsFileA1] <- 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, String
concatenationsFileA]
  let ([String]
choices,[String]
args00)
       | GQtyArgs
multiple forall a. Eq a => a -> a -> Bool
== GQtyArgs
1 = (\(Args
rs,[String]
js) -> (forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getC String
"+m" Args
rs,[String]
js)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstChars -> CLSpecifications -> [String] -> (Args, [String])
takeCs1R FirstChars
fstCharsM CLSpecifications
cSpecs1 forall a b. (a -> b) -> a -> b
$ [String]
args0
       | Bool
otherwise = (forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeBsR [(String
"+g",GQtyArgs
1)] forall a b. (a -> b) -> a -> b
$ [String]
args0,[String]
args0)
      !args1 :: [String]
args1 = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeBsR [(String
"+g",GQtyArgs
1)] forall a b. (a -> b) -> a -> b
$ [String]
args00
      !numericArgs :: [String]
numericArgs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) [String]
args1
      !numberI :: GQtyArgs
numberI = forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
1 (forall a. Read a => String -> Maybe a
readMaybe (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 forall a b. (a -> b) -> a -> b
$ [String]
numericArgs)::Maybe Int)
      !file :: String
file = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 forall a b. (a -> b) -> a -> b
$ [String]
args0
      (GWritingSystemPRPLX
wrs, [FirstChars]
ks, CharPhoneticClassification
arr, SegmentRulesG
gs, String
js, String
vs, Concatenations
ysss, Concatenations
zzzsss, String
xs) = String
-> String
-> String
-> String
-> String
-> (GWritingSystemPRPLX, [FirstChars], CharPhoneticClassification,
    SegmentRulesG, String, String, Concatenations, Concatenations,
    String)
innerProcessmentSimple String
gwrsCnts String
controlConts String
segmentData String
concatenationsFileP1 String
concatenationsFileA1
        in forall (m :: * -> *) a. Monad m => a -> m a
return (GWritingSystemPRPLX
wrs, [FirstChars]
ks, CharPhoneticClassification
arr, SegmentRulesG
gs, String
js, String
vs, Concatenations
ysss, Concatenations
zzzsss, String
xs, [String]
numericArgs, [String]
choices, GQtyArgs
numberI, String
file)

aSpecs :: CLSpecifications
aSpecs :: CLSpecifications
aSpecs = [(String
"+c",GQtyArgs
0)]

aSpcs :: [String] -> Args
aSpcs :: [String] -> Args
aSpcs = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeAsR CLSpecifications
aSpecs

cSpecs1 :: CLSpecifications
cSpecs1 :: CLSpecifications
cSpecs1 = [(String
"+m",-GQtyArgs
1)]

fstCharsM :: FirstChars
fstCharsM :: FirstChars
fstCharsM = (Char
'+',Char
'-')

bSpecs :: CLSpecifications
bSpecs :: CLSpecifications
bSpecs = forall a b. [a] -> [b] -> [(a, b)]
zip [String
"+d",String
"+g",String
"+p"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$ [GQtyArgs
1]

bSpcs :: [String] -> Args
bSpcs :: [String] -> Args
bSpcs = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeBsR CLSpecifications
bSpecs

specs1 :: CLSpecifications
specs1 :: CLSpecifications
specs1 = CLSpecifications
aSpecs forall a. Monoid a => a -> a -> a
`mappend` CLSpecifications
bSpecs forall a. Monoid a => a -> a -> a
`mappend` CLSpecifications
cSpecs1