-- |
-- Module      :  Phonetic.Languages.General.Simple.Parsing
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Prints the rearrangements with the \"property\" information for the phonetic language text. Is used for the
-- Phonetic.Languages.General.Simple module functionality.

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

module Phonetic.Languages.General.Simple.Parsing where

import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Data.Phonetic.Languages.PrepareText
import System.Environment (getArgs)
import Phonetic.Languages.General.Simple
import Data.List (sort)
import GHC.Arr
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import Data.Phonetic.Languages.SpecificationsRead

-- | Prints the rearrangements with the \"property\" information for the phonetic language text.
-- Most of the arguments are obtained from the 'getArgs' function.
-- While used, it distinguishes between two groups of command line arguments: the first four ones and the others afterwards.
-- 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).
--
-- Afterwards, the meaning of the command line arguments are as follows (from the left to the right).
--
-- The first next command line argument must be a
-- positive 'Int' number and is a number of printed variants for the line (if they are present, otherwise just all possible variants are printed).
-- The second one is the number of the intervals into which the all range of possible metrics values are divided. The next numeric arguments that must be
-- sequenced without interruptions further are treated as the numbers of the intervals (counting is started from 1) which values are moved to the maximum
-- values of the metrics interval using the 'unsafeSwapVecIWithMaxI' function. The first textual command line argument should be in the form either \"y0\",
-- or \"0y\", or \"yy\", or \"y\", or \"02y\", or \"y2\", or \"03y\", or \"yy2\", or \"y3\", or some other variant and specifies, which property or properties is or are evaluated.
-- The rest of the command line arguments is the phonetic text. Besides, you can use multiple metrices (no more than 5 different ones) together by
-- using \"+M\" ... \"-M\" command line arguments.
--
-- You can specify constraints according to the 'decodeLConstraints' function between +A and -A next command line arguments. If so, the program will
-- ask you additional question before proceeding. The \"+M\" ... \"-M\" and \"+A\" ... \"-A\" groups must not mutually intersect one another.
argsToSimplePrepare
 :: (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 ()
argsToSimplePrepare :: (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]] -> IO ()
argsToSimplePrepare Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs = do
 [String]
args000 <- IO [String]
getArgs
 let (![String]
args14,![String]
args00) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [String]
args000
     [String
fileGWrSys, String
controlFile, String
segmentRulesFile, String
concatenationsFileP] = [String]
args14
 (String
gwrsCnts, String
controlConts, String
segmentData, String
concatenationsFile, String
toFileMode1, Bool
interactiveP, Bool
jstL0, [String]
args0, Coeffs2
coeffs, [String]
args, Bool
lstW) <- String
-> String
-> String
-> String
-> [String]
-> IO
     (String, String, String, String, String, Bool, Bool, [String],
      Coeffs2, [String], Bool)
argsProcessment String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP [String]
args00
 let (GWritingSystemPRPLX
wrs, [(Char, Char)]
ks, CharPhoneticClassification
arr, SegmentRulesG
gs, String
js, String
vs, Concatenations
ysss, String
ws) = String
-> String
-> String
-> String
-> (GWritingSystemPRPLX, [(Char, Char)],
    CharPhoneticClassification, SegmentRulesG, String, String,
    Concatenations, String)
innerProcessmentSimple String
gwrsCnts String
controlConts String
segmentData String
concatenationsFile 
 if Coeffs2 -> Bool
forall a. CoeffTwo a -> Bool
isPair Coeffs2
coeffs then GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> [String]
-> Bool
-> IO ()
generalProc2G GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs Concatenations
ysss String
ws {- old arguments follow -} String
toFileMode1 Bool
interactiveP Bool
jstL0 [String]
args0 Coeffs2
coeffs (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
args) Bool
lstW
 else GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> [String]
-> Bool
-> IO ()
generalProc2G GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs Concatenations
ysss String
ws String
toFileMode1 Bool
interactiveP Bool
jstL0 [String]
args0 Coeffs2
coeffs [String]
args Bool
lstW
 
-- | Similar to the 'argsToSimplePrepare' function, but takes explicitly the four 'FilePath's for the files
-- respectively and the last argument the 'String' with all the other specifications. If it is not proper,
-- the functions returns an error.
argsToSimplePrepare4Files
 :: 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 -- ^ A 'String' of data that are the further command line arguments for the function 'argsToSimplePrepare'.
 -> IO ()
argsToSimplePrepare4Files :: String
-> String
-> String
-> String
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> String
-> IO ()
argsToSimplePrepare4Files String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs String
other_args = do
 let args000 :: [String]
args000 = String -> [String]
words String
other_args
     args00 :: [String]
args00 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
4 [String]
args000
 (String
gwrsCnts, String
controlConts, String
segmentData, String
concatenationsFile, String
toFileMode1, Bool
interactiveP, Bool
jstL0, [String]
args0, Coeffs2
coeffs, [String]
args, Bool
lstW) <- String
-> String
-> String
-> String
-> [String]
-> IO
     (String, String, String, String, String, Bool, Bool, [String],
      Coeffs2, [String], Bool)
argsProcessment String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP [String]
args00
 let (GWritingSystemPRPLX
wrs, [(Char, Char)]
ks, CharPhoneticClassification
arr, SegmentRulesG
gs, String
js, String
vs, Concatenations
ysss, String
ws) = String
-> String
-> String
-> String
-> (GWritingSystemPRPLX, [(Char, Char)],
    CharPhoneticClassification, SegmentRulesG, String, String,
    Concatenations, String)
innerProcessmentSimple String
gwrsCnts String
controlConts String
segmentData String
concatenationsFile 
 if Coeffs2 -> Bool
forall a. CoeffTwo a -> Bool
isPair Coeffs2
coeffs then GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> [String]
-> Bool
-> IO ()
generalProc2G GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs Concatenations
ysss String
ws {- old arguments follow -} String
toFileMode1 Bool
interactiveP Bool
jstL0 [String]
args0 Coeffs2
coeffs (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
args) Bool
lstW
 else GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> [[[[PRS]]] -> [[Double]]]
-> Concatenations
-> String
-> String
-> Bool
-> Bool
-> [String]
-> Coeffs2
-> [String]
-> Bool
-> IO ()
generalProc2G GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> [[[PRS]]] -> [[Double]]
h [[[[PRS]]] -> [[Double]]]
qs Concatenations
ysss String
ws String
toFileMode1 Bool
interactiveP Bool
jstL0 [String]
args0 Coeffs2
coeffs [String]
args Bool
lstW
 
innerProcessmentSimple
  :: String -- ^ Must be a valid 'GWritingSystemPRPLX' specifications 'String' representation only (see the gwrsysExample.txt file in the @phonetic-languages-phonetics-basics@ package as a schema);
  -> String -- ^ Must be a 'String' 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;
  -> String -- ^ Must be a 'String' with the 'SegmentRulesG' specifications only;
  -> String -- ^ Must be a 'String' 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).
  -> (GWritingSystemPRPLX, [(Char, Char)], CharPhoneticClassification, SegmentRulesG, String, String, Concatenations, String)
innerProcessmentSimple :: String
-> String
-> String
-> String
-> (GWritingSystemPRPLX, [(Char, Char)],
    CharPhoneticClassification, SegmentRulesG, String, String,
    Concatenations, String)
innerProcessmentSimple String
gwrsCnts String
controlConts String
segmentData String
concatenationsFile = 
 let [[String]
allophonesGs, [String]
charClfs, [String]
jss, [String]
vss, [String]
wss] = Char -> [String] -> Concatenations
groupBetweenChars Char
'~' ([String] -> Concatenations)
-> (String -> [String]) -> String -> Concatenations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Concatenations) -> String -> Concatenations
forall a b. (a -> b) -> a -> b
$ String
controlConts
     wrs :: GWritingSystemPRPLX
wrs = Char -> String -> GWritingSystemPRPLX
getGWritingSystem Char
'~' String
gwrsCnts
     ks :: [(Char, Char)]
ks = [(Char, Char)] -> [(Char, Char)]
forall a. Ord a => [a] -> [a]
sort ([(Char, Char)] -> [(Char, Char)])
-> (Maybe [(Char, Char)] -> [(Char, Char)])
-> Maybe [(Char, Char)]
-> [(Char, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Char)] -> Maybe [(Char, Char)] -> [(Char, Char)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(Char, Char)] -> [(Char, Char)])
-> Maybe [(Char, Char)] -> [(Char, Char)]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe [(Char, Char)]
forall a. Read a => String -> Maybe a
readMaybe ([String] -> String
unwords [String]
allophonesGs)::Maybe [(Char, Char)])
     arr :: CharPhoneticClassification
arr = String -> CharPhoneticClassification
forall a. Read a => String -> a
read ([String] -> String
unwords [String]
charClfs)::Array Int PRS -- The 'Array' must be previously sorted in the ascending order.
     gs :: SegmentRulesG
gs = String -> SegmentRulesG
forall a. Read a => String -> a
read String
segmentData::SegmentRulesG
     ysss :: Concatenations
ysss = Concatenations -> Concatenations
sort2Concat (Concatenations -> Concatenations)
-> (Maybe Concatenations -> Concatenations)
-> Maybe Concatenations
-> Concatenations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concatenations -> Maybe Concatenations -> Concatenations
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Concatenations -> Concatenations)
-> Maybe Concatenations -> Concatenations
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Concatenations
forall a. Read a => String -> Maybe a
readMaybe String
segmentData::Maybe [[String]])
     js :: String
js = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
jss
     vs :: String
vs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
vss
     ws :: String
ws = String -> String
forall a. Ord a => [a] -> [a]
sort (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
forall a b. (a -> b) -> a -> b
$ [String]
wss
       in (GWritingSystemPRPLX
wrs, [(Char, Char)]
ks, CharPhoneticClassification
arr, SegmentRulesG
gs, String
js, String
vs, Concatenations
ysss, String
ws)

argsProcessment
 :: 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).
 -> [String] -- ^ List of other args afterwards.
 -> IO (String, String, String, String, String, Bool, Bool, [String], Coeffs2, [String], Bool)
argsProcessment :: String
-> String
-> String
-> String
-> [String]
-> IO
     (String, String, String, String, String, Bool, Bool, [String],
      Coeffs2, [String], Bool)
argsProcessment String
fileGWrSys String
controlFile String
segmentRulesFile String
concatenationsFileP [String]
args00 = do
 let args0 :: [String]
args0 = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
xs -> String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"++B" Bool -> Bool -> Bool
&& String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"++L" Bool -> Bool -> Bool
&& String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"++BL" Bool -> Bool -> Bool
&& String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"++I" Bool -> Bool -> Bool
&& String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+U") [String]
args00
     lstW :: Bool
lstW = if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
x -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"++B" Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"++BL") [String]
args00 then Bool
True else Bool
False -- If one of the command line options is \"++B\" or \"++BL\" then the last word of the line will remain the last one.
     jstL0 :: Bool
jstL0 = if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
x -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"++L" Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"++BL") [String]
args00 then Bool
True else Bool
False -- If one of the command line options is \"++L\" or \"++BL\" then the program outputs just lines without metrices values.
     toFileMode1 :: String
toFileMode1 = [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]) -> [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
"+IF") ([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
"-IF") ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args0  -- Prints the last resulting line of the interactive mode processment (the last selected variant) to the file and also to the stdout.
     interactiveP :: Bool
interactiveP = if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
xs -> String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"++I" Bool -> Bool -> Bool
|| String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+IF") [String]
args00 then Bool
True else Bool
False -- If one of the command line options is \"++I\", or \"+IF\" then the program prints the variants and then prompts for the preferred variant. Afterwards, it prints just that variant alone.
     args01 :: [String]
args01 = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+A") [String]
args0 [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` (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
"-A") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
args0)
     args02 :: [String]
args02
      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
toFileMode1 = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
xs -> String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+IF" Bool -> Bool -> Bool
&& String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-IF") [String]
args01
      | Bool
otherwise = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+IF") [String]
args01 [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` (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
"-IF") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
args01)
     args :: [String]
args = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+M") [String]
args02 [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` (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]
forall a b. (a -> b) -> a -> b
$ [String]
args02)
     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
 [String
controlConts, String
gwrsCnts, String
segmentData, String
concatenationsFile] <- (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
controlFile, String
fileGWrSys, String
segmentRulesFile, String
concatenationsFileP]
 (String, String, String, String, String, Bool, Bool, [String],
 Coeffs2, [String], Bool)
-> IO
     (String, String, String, String, String, Bool, Bool, [String],
      Coeffs2, [String], Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
gwrsCnts, String
controlConts, String
segmentData, String
concatenationsFile, String
toFileMode1, Bool
interactiveP, Bool
jstL0, [String]
args0, Coeffs2
coeffs, [String]
args, Bool
lstW)