-- |
-- Module      :  Interpreter.ArgsConversion
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Prints the rearrangements with the \"property\" information for the Ukrainian language text.

{-# OPTIONS_GHC -threaded -rtsopts #-}


module Interpreter.ArgsConversion where

import Phonetic.Languages.Coeffs
import Interpreter.StringConversion (readFileIfAny)
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import CLI.Arguments
import CLI.Arguments.Parsing
import CLI.Arguments.Get
import Phonetic.Languages.Permutations.Represent

argsConversion :: String -> ([Char], PermutationsType, Bool, Bool, [String], Coeffs2, Coeffs2, [String], Bool, Bool, Int, Int)
argsConversion :: String
-> (String, PermutationsType, Bool, Bool, [String], Coeffs2,
    Coeffs2, [String], Bool, Bool, GQtyArgs, GQtyArgs)
argsConversion String
xs = 
 let args50 :: [String]
args50 = String -> [String]
words String
xs
     (Args
cfWX,[String]
args501) = CLSpecifications -> [String] -> (Args, [String])
takeBsR [(String
"+x",GQtyArgs
1)] [String]
args50
     coeffsWX :: Coeffs2
coeffsWX = String -> Coeffs2
readCF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+x" forall a b. (a -> b) -> a -> b
$ Args
cfWX -- The line argument that starts with \"+x\".
     (Args
argsA,Args
argsB,Args
argsC1,[String]
argss) = FirstChars
-> CLSpecifications -> [String] -> (Args, Args, Args, [String])
args2Args31R FirstChars
fstCharsMA CLSpecifications
specs1 [String]
args501
     pairwisePermutations :: PermutationsType
pairwisePermutations = [String] -> PermutationsType
bTransform2Perms forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+p" forall a b. (a -> b) -> a -> b
$ Args
argsB
     fileDu :: String
fileDu = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+d" forall a b. (a -> b) -> a -> b
$ Args
argsB -- Whether to use the own PhoPaaW weights (durations) from the file specified here. Is used only in @phonetic-languages-simplified-examples-array@ package
     lstW :: Bool
lstW = forall (t :: * -> *). Foldable t => [String] -> t Arguments -> Bool
listA [String
"+b",String
"+bl"] Args
argsA -- If one of the line options is \"+b\" or \"+bl\" then the last word of the line will remain the last one.
     jstL0 :: Bool
jstL0 = forall (t :: * -> *). Foldable t => [String] -> t Arguments -> Bool
listA [String
"+l",String
"+bl"] Args
argsA -- If one of the line options is \"+l\" or \"+bl\" then the program outputs just lines without metrices values.
     nativeUkrainian :: Bool
nativeUkrainian = forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneA String
"+u" Args
argsA -- If one of the line options is \"+u\" then the informational messages are printed in Ukrainian, otherwise (the default behaviour) they are in English.
     -- Is used only in @phonetic-languages-simplified-examples-array@ package.
     verbose0 :: String
verbose0 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+v" forall a b. (a -> b) -> a -> b
$ Args
argsB -- ^ Whether to use more verbose output 
     verbose :: GQtyArgs
verbose = forall a. Num a => a -> a
abs (forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
0 (forall a. Read a => String -> Maybe a
readMaybe String
verbose0::Maybe Int) forall a. Integral a => a -> a -> a
`rem` GQtyArgs
4)
     syllables :: Bool
syllables =  forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneB String
"+s" Args
argsB -- Whether to use syllable durations, up to 9 different sets.
     syllablesVs :: GQtyArgs
syllablesVs = forall a. Ord a => a -> a -> a
max GQtyArgs
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe GQtyArgs
1 forall a b. (a -> b) -> a -> b
$ (forall a. Read a => String -> Maybe a
readMaybe (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
"+s" forall a b. (a -> b) -> a -> b
$ Args
argsB)::Maybe Int) -- Number of sets of syllable durations to be used
     args0 :: [String]
args0 = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeAsR CLSpecifications
aSpecs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeBsR [(String
"+d",GQtyArgs
1)] forall a b. (a -> b) -> a -> b
$ [String]
args501
     args :: [String]
args = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstChars -> CLSpecifications -> [String] -> (Args, [String])
takeCs1R FirstChars
fstCharsMA [(String
"+m",-GQtyArgs
1)] forall a b. (a -> b) -> a -> b
$ [String]
argss
     coeffs :: Coeffs2
coeffs = String -> Coeffs2
readCF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GQtyArgs -> [a] -> [a]
take GQtyArgs
1 forall a b. (a -> b) -> a -> b
$ [String]
args -- The first line argument.
       in (String
fileDu,PermutationsType
pairwisePermutations,Bool
nativeUkrainian,Bool
jstL0,[String]
args0,Coeffs2
coeffs,Coeffs2
coeffsWX,[String]
args,Bool
lstW,Bool
syllables,GQtyArgs
syllablesVs,GQtyArgs
verbose)

aSpecs :: CLSpecifications
aSpecs :: CLSpecifications
aSpecs = forall a b. [a] -> [b] -> [(a, b)]
zip [String
"+b",String
"+l",String
"+bl",String
"+u"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$ [GQtyArgs
0]

aSpcs :: [String] -> Args
aSpcs :: [String] -> Args
aSpcs = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> (Args, [String])
takeAsR CLSpecifications
aSpecs

cSpecs1MA :: CLSpecifications
cSpecs1MA :: CLSpecifications
cSpecs1MA = [(String
"+m",-GQtyArgs
1)]

fstCharsMA :: FirstChars
fstCharsMA :: FirstChars
fstCharsMA = (Char
'+',Char
'-')

bSpecs :: CLSpecifications
bSpecs :: CLSpecifications
bSpecs = forall a b. [a] -> [b] -> [(a, b)]
zip [String
"+d",String
"+p",String
"+s",String
"+v"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$ [GQtyArgs
1]

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

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