-- |
-- 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 -> 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]
 -> IO ()
argsToGetInfoProcessment :: (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL] -> IO ()
argsToGetInfoProcessment Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs = do
 [String]
args500 <- IO [String]
getArgs
 let (Args
pPs,[String]
args50) = CLSpecifications -> [String] -> (Args, [String])
takeBsR [(String
"+p",GQtyArgs
1)] [String]
args500
     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]
args15,![String]
args000) = GQtyArgs -> [String] -> ([String], [String])
forall a. GQtyArgs -> [a] -> ([a], [a])
splitAt GQtyArgs
5 [String]
args50
     [String
fileGWrSys, String
controlFile, String
segmentRulesFile, String
concatenationsFileP, String
concatenationsFileA] = [String]
args15
 PermutationsType
-> String
-> String
-> String
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [String]
-> IO ()
files4ArgsProcessment PermutationsType
pairwisePermutations String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP String
concatenationsFileA Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
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). 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 -> 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] -- ^ List of other command line arguments
  -> IO ()
files4ArgsProcessment :: PermutationsType
-> String
-> String
-> String
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> [String]
-> IO ()
files4ArgsProcessment PermutationsType
pairwisePermutations !String
fileGWrSys !String
controlFile !String
segmentRulesFile !String
concatenationsFileP !String
concatenationsFileA Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs [String]
args000 = do
 [String
fileGWrSys1, String
controlFile1, String
segmentRulesFile1, String
concatenationsFileP1, String
concatenationsFileA1] <- (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
fileGWrSys, String
controlFile, String
segmentRulesFile, String
concatenationsFileP, String
concatenationsFileA]
 let (Args
argsA,Args
argsB,Args
argsC1,[String]
_) = 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, !Concatenations
zzzsss, !String
xs) = String
-> String
-> String
-> String
-> String
-> (GWritingSystemPRPLX, [FirstChars], CharPhoneticClassification,
    SegmentRulesG, String, String, Concatenations, Concatenations,
    String)
innerProcessmentSimple String
fileGWrSys1 String
controlFile1 String
segmentRulesFile1 String
concatenationsFileP1 String
concatenationsFileA1
 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 -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> 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 -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss 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
-> 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 Concatenations
zzzsss 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 -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> 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 -> MappingFunctionPL
h [MappingFunctionPL]
qs Concatenations
ysss Concatenations
zzzsss 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
-> 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 Concatenations
zzzsss 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