-- |
-- Module : Phonetic.Languages.General.GetInfo.Parsing
-- Copyright : (c) OleksandrZhabenko 2020-2022
-- 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 Phonetic.Languages.General.Common
import Data.Phonetic.Languages.Syllables
import Phonetic.Languages.General.Simple.Parsing (innerProcessmentSimple)
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import CLI.Arguments
import CLI.Arguments.Parsing
import CLI.Arguments.Get
import qualified Phonetic.Languages.Permutations.Represent as R
-- | The first 5 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). These are to be prepended to the next word.
--
-- 5) 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.
--
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 h qs = do
args500 <- getArgs
let (pPs,args50) = takeBsR [("+p",1)] args500
pairwisePermutations = R.bTransform2Perms . getB "+p" $ pPs
(!args15,!args000) = splitAt 5 args50
[fileGWrSys, controlFile, segmentRulesFile, concatenationsFileP, concatenationsFileA] = args15
files4ArgsProcessment pairwisePermutations fileGWrSys controlFile segmentRulesFile concatenationsFileP concatenationsFileA h qs args000
files4ArgsProcessment
:: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
-> 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 ones are to be prepended to the next word after them.
-> 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 ones are to be prepended to the next word after them.
-> (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 pairwisePermutations !fileGWrSys !controlFile !segmentRulesFile !concatenationsFileP !concatenationsFileA h qs args000 = do
[fileGWrSys1, controlFile1, segmentRulesFile1, concatenationsFileP1, concatenationsFileA1] <- mapM readFile [fileGWrSys, controlFile, segmentRulesFile, concatenationsFileP, concatenationsFileA]
let (argsA,argsB,argsC1,_) = args2Args31R fstCharsM specs1 args000
!args00 = snd . takeAsR [("+b",0)] . snd . takeBsR [("+x",1),("+g",1)] $ args000
!growing = concat . getB "+g" $ argsB
(!gr1,!gr2)
| null growing = (0,0)
| otherwise = let (nms,mms) = splitAt 1 growing
nm = readMaybe nms::Maybe Int
mm = readMaybe mms::Maybe Int in case (nm,mm) of
(Just n4,Just m4) -> if (m4 `rem` 7) < (n4 `rem` 7) then (n4 `rem` 7 + 1, m4 `rem` 7 + 1) else (0,0)
_ -> (0,0)
!lstW = oneA "+b" argsA
!args0 = snd . takeCs1R fstCharsM cSpecs1 $ args00
!multiples = getC "+m" argsC1 -- Arguments for multiple metrices mode
!args = filter (\xs -> all (/= ':') xs && all (/= '@') xs) args0
!coeffs = readCF . concat . take 1 $ args
!coeffsWX = readCF . concat . getB "+x" $ argsB
!lInes = filter (any (== ':')) args0
!numbersJustPrint = filter (== "@n") args0
(!wrs, !ks, !arr, !gs, !js, !vs, !ysss, !zzzsss, !xs) = innerProcessmentSimple fileGWrSys1 controlFile1 segmentRulesFile1 concatenationsFileP1 concatenationsFileA1
if isPair coeffs then do
let !file = concat . drop 1 . take 2 $ args
if null numbersJustPrint then do
let !gzS = concat . take 1 . drop 2 $ args
!printLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 3 $ args)::(Maybe Int))
!toOneLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 4 $ args)::(Maybe Int))
!choice = concat . drop 5 . take 6 $ args
generalProc pairwisePermutations (gr1,gr2) wrs ks arr gs h qs ysss zzzsss xs js vs {- the old arguments follow -} lstW multiples lInes coeffs coeffsWX file gzS printLine toOneLine choice
else do
contents <- readFile file
fLinesNIO (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs contents
else do
let !file = concat . take 1 $ args
if null numbersJustPrint then do
let !gzS = concat . take 1 . drop 1 $ args
!printLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 2 $ args)::(Maybe Int))
!toOneLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 3 $ args)::(Maybe Int))
!choice = concat . drop 4 . take 5 $ args
generalProc pairwisePermutations (gr1,gr2) wrs ks arr gs h qs ysss zzzsss xs js vs {- the old arguments follow -} lstW multiples lInes coeffs coeffsWX file gzS printLine toOneLine choice
else do
contents <- readFile file
fLinesNIO (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs contents
aSpecs :: CLSpecifications
aSpecs = [("+b",0)]
aSpcs :: [String] -> Args
aSpcs = fst . takeAsR aSpecs
cSpecs1 :: CLSpecifications
cSpecs1 = [("+m",-1)]
fstCharsM :: FirstChars
fstCharsM = ('+','-')
bSpecs :: CLSpecifications
bSpecs = zip ["+g","+x","+p"] . cycle $ [1]
bSpcs :: [String] -> Args
bSpcs = fst . takeBsR bSpecs
specs1 :: CLSpecifications
specs1 = aSpecs `mappend` bSpecs `mappend` cSpecs1