-- |
-- 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 Data.Monoid (mappend)
import Phonetic.Languages.General.Common
import Phonetic.Languages.General.Lines
import Data.Phonetic.Languages.PrepareText
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 (innerProcessmentSimple)
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Phonetic.Languages.General.Simple
import Data.Phonetic.Languages.SpecificationsRead
import CLI.Arguments
import CLI.Arguments.Parsing
import CLI.Arguments.Get
import qualified Phonetic.Languages.Permutations.Represent as R


-- | 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]
args50 <- IO [String]
getArgs
 let (Args
pPs,[String]
args40) = CLSpecifications -> [String] -> (Args, [String])
takeBsR [(String
"+p",GQtyArgs
1)] [String]
args50
     pairwisePermutations :: PermutationsType
pairwisePermutations = [String] -> PermutationsType
R.bTransform2Perms ([String] -> PermutationsType)
-> (Args -> [String]) -> Args -> PermutationsType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+p" (Args -> PermutationsType) -> Args -> PermutationsType
forall a b. (a -> b) -> a -> b
$ Args
pPs
     (![String]
args14,![String]
args000) = GQtyArgs -> [String] -> ([String], [String])
forall a. GQtyArgs -> [a] -> ([a], [a])
splitAt GQtyArgs
4 [String]
args40
     [String
fileGWrSys, String
controlFile, String
segmentRulesFile, String
concatenationsFileP] = [String]
args14
 PermutationsType
-> String
-> String
-> String
-> String
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> [String]
-> IO ()
files4ArgsProcessment PermutationsType
pairwisePermutations String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs [String]
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).
  -> (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 :: PermutationsType
-> String
-> String
-> String
-> String
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> [String]
-> IO ()
files4ArgsProcessment PermutationsType
pairwisePermutations !String
fileGWrSys !String
controlFile !String
segmentRulesFile !String
concatenationsFileP Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs [String]
args000 = do
 let (Args
argsA,Args
argsB,Args
argsC1,[String]
argss) = FirstChars
-> CLSpecifications -> [String] -> (Args, Args, Args, [String])
args2Args31R FirstChars
fstCharsM CLSpecifications
specs1 [String]
args000
     !args00 :: [String]
args00 = (Args, [String]) -> [String]
forall a b. (a, b) -> b
snd ((Args, [String]) -> [String])
-> ([String] -> (Args, [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeAsR [(String
"+b",GQtyArgs
0)] ([String] -> (Args, [String]))
-> ([String] -> [String]) -> [String] -> (Args, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Args, [String]) -> [String]
forall a b. (a, b) -> b
snd ((Args, [String]) -> [String])
-> ([String] -> (Args, [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeBsR [(String
"+x",GQtyArgs
1),(String
"+g",GQtyArgs
1)] ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
args000
     !growing :: String
growing = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Args -> [String]) -> Args -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+g" (Args -> String) -> Args -> String
forall a b. (a -> b) -> a -> b
$ Args
argsB
     (!GQtyArgs
gr1,!GQtyArgs
gr2)
            | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
growing = (GQtyArgs
0,GQtyArgs
0)
            | Bool
otherwise = let (String
nms,String
mms) = GQtyArgs -> String -> (String, String)
forall a. GQtyArgs -> [a] -> ([a], [a])
splitAt GQtyArgs
1 String
growing
                              nm :: Maybe GQtyArgs
nm = String -> Maybe GQtyArgs
forall a. Read a => String -> Maybe a
readMaybe String
nms::Maybe Int
                              mm :: Maybe GQtyArgs
mm = String -> Maybe GQtyArgs
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 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
`rem` GQtyArgs
7) GQtyArgs -> GQtyArgs -> Bool
forall a. Ord a => a -> a -> Bool
< (GQtyArgs
n4 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
`rem` GQtyArgs
7) then (GQtyArgs
n4 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
`rem` GQtyArgs
7 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
+ GQtyArgs
1, GQtyArgs
m4 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Integral a => a -> a -> a
`rem` GQtyArgs
7 GQtyArgs -> GQtyArgs -> GQtyArgs
forall a. Num a => a -> a -> a
+ GQtyArgs
1) else (GQtyArgs
0,GQtyArgs
0)
                                  (Maybe GQtyArgs, Maybe GQtyArgs)
_ -> (GQtyArgs
0,GQtyArgs
0)
     !lstW :: Bool
lstW = String -> Args -> Bool
forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneA String
"+b" Args
argsA
     !args0 :: [String]
args0 = (Args, [String]) -> [String]
forall a b. (a, b) -> b
snd ((Args, [String]) -> [String])
-> ([String] -> (Args, [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstChars -> CLSpecifications -> [String] -> (Args, [String])
takeCs1R FirstChars
fstCharsM CLSpecifications
cSpecs1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
args00
     !multiples :: [String]
multiples = String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getC String
"+m" Args
argsC1 -- 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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 ([String] -> Coeffs2) -> [String] -> Coeffs2
forall a b. (a -> b) -> a -> b
$ [String]
args
     !coeffsWX :: Coeffs2
coeffsWX = String -> Coeffs2
readCF (String -> Coeffs2) -> (Args -> String) -> Args -> Coeffs2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Args -> [String]) -> Args -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Args -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+x" (Args -> Coeffs2) -> Args -> Coeffs2
forall a b. (a -> b) -> a -> b
$ Args
argsB
     !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, ![FirstChars]
ks, !CharPhoneticClassification
arr, !SegmentRulesG
gs, !String
js, !String
vs, !Concatenations
ysss, !String
xs) = String
-> String
-> String
-> String
-> (GWritingSystemPRPLX, [FirstChars], 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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
2 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args
       !printLine :: GQtyArgs
printLine = GQtyArgs -> Maybe GQtyArgs -> GQtyArgs
forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
0 (String -> Maybe GQtyArgs
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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
3 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args)::(Maybe Int))
       !toOneLine :: GQtyArgs
toOneLine = GQtyArgs -> Maybe GQtyArgs -> GQtyArgs
forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
0 (String -> Maybe GQtyArgs
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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
5 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
6 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args
   PermutationsType
-> (GQtyArgs, GQtyArgs)
-> GWritingSystemPRPLX
-> [FirstChars]
-> CharPhoneticClassification
-> SegmentRulesG
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> Concatenations
-> String
-> String
-> String
-> Bool
-> [String]
-> [String]
-> Coeffs2
-> Coeffs2
-> String
-> String
-> GQtyArgs
-> GQtyArgs
-> String
-> IO ()
generalProc PermutationsType
pairwisePermutations (GQtyArgs
gr1,GQtyArgs
gr2) GWritingSystemPRPLX
wrs [FirstChars]
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 GQtyArgs
printLine GQtyArgs
toOneLine String
choice
  else do
   String
contents <- String -> IO String
readFile String
file
   GQtyArgs
-> Concatenations -> String -> String -> String -> String -> IO ()
fLinesNIO (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= GQtyArgs -> PermutationsType
R.P GQtyArgs
0 then GQtyArgs
10 else GQtyArgs
7) 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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
1 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args
       !printLine :: GQtyArgs
printLine = GQtyArgs -> Maybe GQtyArgs -> GQtyArgs
forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
0 (String -> Maybe GQtyArgs
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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
2 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args)::(Maybe Int))
       !toOneLine :: GQtyArgs
toOneLine = GQtyArgs -> Maybe GQtyArgs -> GQtyArgs
forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
0 (String -> Maybe GQtyArgs
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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
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
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
drop GQtyArgs
4 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQtyArgs -> [String] -> [String]
forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
5 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args
   PermutationsType
-> (GQtyArgs, GQtyArgs)
-> GWritingSystemPRPLX
-> [FirstChars]
-> CharPhoneticClassification
-> SegmentRulesG
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> Concatenations
-> String
-> String
-> String
-> Bool
-> [String]
-> [String]
-> Coeffs2
-> Coeffs2
-> String
-> String
-> GQtyArgs
-> GQtyArgs
-> String
-> IO ()
generalProc PermutationsType
pairwisePermutations (GQtyArgs
gr1,GQtyArgs
gr2) GWritingSystemPRPLX
wrs [FirstChars]
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 GQtyArgs
printLine GQtyArgs
toOneLine String
choice
  else do
   String
contents <- String -> IO String
readFile String
file
   GQtyArgs
-> Concatenations -> String -> String -> String -> String -> IO ()
fLinesNIO (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= GQtyArgs -> PermutationsType
R.P GQtyArgs
0 then GQtyArgs
10 else GQtyArgs
7) Concatenations
ysss String
xs String
js String
vs String
contents

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

aSpcs :: [String] -> Args
aSpcs :: [String] -> Args
aSpcs = (Args, [String]) -> Args
forall a b. (a, b) -> a
fst ((Args, [String]) -> Args)
-> ([String] -> (Args, [String])) -> [String] -> Args
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 = [String] -> [GQtyArgs] -> CLSpecifications
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"+g",String
"+x",String
"+p"] ([GQtyArgs] -> CLSpecifications)
-> ([GQtyArgs] -> [GQtyArgs]) -> [GQtyArgs] -> CLSpecifications
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GQtyArgs] -> [GQtyArgs]
forall a. [a] -> [a]
cycle ([GQtyArgs] -> CLSpecifications) -> [GQtyArgs] -> CLSpecifications
forall a b. (a -> b) -> a -> b
$ [GQtyArgs
1]

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

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