-- |
-- Module      :  Phonetic.Languages.General.GetInfo.Parsing
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Can be used to analyze a poetic text in a phonetic language, for every line printing statistic data.
--

{-# OPTIONS_GHC -threaded #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}

module Phonetic.Languages.General.GetInfo.Parsing where

import Phonetic.Languages.General.GetTextualInfo
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import System.Environment (getArgs)
import Data.Monoid (mappend)
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
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Phonetic.Languages.General.Simple
import Data.Phonetic.Languages.SpecificationsRead

-- | The first 4 arguments are the file names with the specifications.
-- 1) with the 'GWritingSystemPRPLX' specifications only (see the gwrsysExample.txt file in the @phonetic-languages-phonetics-basics@ package as a schema);
--
-- 2) 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;
--
-- 3) with the 'SegmentRulesG' specifications only;
--
-- 4) 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).
--
argsToGetInfoProcessment
  :: (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 ()
argsToGetInfoProcessment :: (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]] -> IO ()
argsToGetInfoProcessment Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs = do
 [String]
args40 <- IO [String]
getArgs
 let (![String]
args14,![String]
args000) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [String]
args40
     [String
fileGWrSys, String
controlFile, String
segmentRulesFile, String
concatenationsFileP] = [String]
args14
 String
-> String
-> String
-> String
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> [String]
-> IO ()
files4ArgsProcessment String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs [String]
args000

files4ArgsProcessment
  :: 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).
  -> (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.
  -> [String] -- ^ List of other command line arguments
  -> IO ()
files4ArgsProcessment :: String
-> String
-> String
-> String
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> [String]
-> IO ()
files4ArgsProcessment !String
fileGWrSys !String
controlFile !String
segmentRulesFile !String
concatenationsFileP Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs [String]
args000 = do
 let !args00 :: [String]
args00 = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
ts -> Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+X" Bool -> Bool -> Bool
&& String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"++B") [String]
args000
     !lstW :: Bool
lstW = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"++B") [String]
args000
     !args0 :: [String]
args0 = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+M") [String]
args00 [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-M") [String]
args00)
     !multiples :: [String]
multiples = 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
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+M") ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-M") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
args00 -- Arguments for multiple metrices mode
     !args :: [String]
args = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
xs -> (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') String
xs Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@') String
xs) [String]
args0
     !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]
args
     !coeffsWX :: Coeffs2
coeffsWX = String -> Coeffs2
readCF (String -> Coeffs2) -> ([String] -> String) -> [String] -> Coeffs2
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
. [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]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
ts -> Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+X") ([String] -> Coeffs2) -> [String] -> Coeffs2
forall a b. (a -> b) -> a -> b
$ [String]
args000
     !lInes :: [String]
lInes = (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
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')) [String]
args0
     !numbersJustPrint :: [String]
numbersJustPrint =  (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"@n") [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
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP
 if Coeffs2 -> Bool
forall a. CoeffTwo a -> Bool
isPair Coeffs2
coeffs then do
  let !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]
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]
args  
  if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
numbersJustPrint then do
   let !gzS :: String
gzS = [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]) -> [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]
args 
       !printLine :: Int
printLine = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (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]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
3 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args)::(Maybe Int))
       !toOneLine :: Int
toOneLine = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (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]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
4 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args)::(Maybe Int))
       !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
5 ([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
6 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args 
   GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> Concatenations
-> String
-> String
-> String
-> Bool
-> [String]
-> [String]
-> Coeffs2
-> Coeffs2
-> String
-> String
-> Int
-> Int
-> String
-> IO ()
generalProc 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 follow -} Bool
lstW [String]
multiples [String]
lInes Coeffs2
coeffs Coeffs2
coeffsWX String
file String
gzS Int
printLine Int
toOneLine String
choice
  else do
   String
contents <- String -> IO String
readFile String
file
   Concatenations -> String -> String -> String -> String -> IO ()
fLinesIO Concatenations
ysss String
xs String
js String
vs String
contents 
 else do
  let !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]
args
  if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
numbersJustPrint then do
   let !gzS :: String
gzS = [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]) -> [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
forall a b. (a -> b) -> a -> b
$ [String]
args
       !printLine :: Int
printLine = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (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]) -> [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]
args)::(Maybe Int))
       !toOneLine :: Int
toOneLine = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (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]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
3 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args)::(Maybe Int))
       !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
4 ([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]
args
   GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> Concatenations
-> String
-> String
-> String
-> Bool
-> [String]
-> [String]
-> Coeffs2
-> Coeffs2
-> String
-> String
-> Int
-> Int
-> String
-> IO ()
generalProc 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 follow -} Bool
lstW [String]
multiples [String]
lInes Coeffs2
coeffs Coeffs2
coeffsWX String
file String
gzS Int
printLine Int
toOneLine String
choice
  else do
   String
contents <- String -> IO String
readFile String
file
   Concatenations -> String -> String -> String -> String -> IO ()
fLinesIO Concatenations
ysss String
xs String
js String
vs String
contents