diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -51,3 +51,7 @@ * Sixth version. Fixed issue with splitting for negative position argument. Added the possibility to concat just two words in any position. Added a variant of the function convStringInterpreterIO with the possibility to correct the long splitting after revision. + +## 0.7.0.0 -- 2022-09-13 + +* Seventh version. Added new module Interpreter.ArgsConversion. Added new lightweight dependencies. diff --git a/Interpreter/ArgsConversion.hs b/Interpreter/ArgsConversion.hs new file mode 100644 --- /dev/null +++ b/Interpreter/ArgsConversion.hs @@ -0,0 +1,64 @@ +-- | +-- 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 xs = + let args50 = words xs + (cfWX,args501) = takeBsR [("+x",1)] args50 + coeffsWX = readCF . concat . getB "+x" $ cfWX -- The line argument that starts with \"+x\". + (argsA,argsB,argsC1,argss) = args2Args31R fstCharsMA specs1 args501 + pairwisePermutations = bTransform2Perms . getB "+p" $ argsB + fileDu = concat . getB "+d" $ 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 = listA ["+b","+bl"] argsA -- If one of the line options is \"+b\" or \"+bl\" then the last word of the line will remain the last one. + jstL0 = listA ["+l","+bl"] argsA -- If one of the line options is \"+l\" or \"+bl\" then the program outputs just lines without metrices values. + nativeUkrainian = oneA "+u" 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 = concat . getB "+v" $ argsB -- ^ Whether to use more verbose output + verbose = abs (fromMaybe 0 (readMaybe verbose0::Maybe Int) `rem` 4) + syllables = oneB "+s" argsB -- Whether to use syllable durations, up to 9 different sets. + syllablesVs = max 1 . fromMaybe 1 $ (readMaybe (concat . getB "+s" $ argsB)::Maybe Int) -- Number of sets of syllable durations to be used + args0 = snd . takeAsR aSpecs . snd . takeBsR [("+d",1)] $ args501 + args = snd . takeCs1R fstCharsMA [("+m",-1)] $ argss + coeffs = readCF . concat . take 1 $ args -- The first line argument. + in (fileDu,pairwisePermutations,nativeUkrainian,jstL0,args0,coeffs,coeffsWX,args,lstW,syllables,syllablesVs,verbose) + +aSpecs :: CLSpecifications +aSpecs = zip ["+b","+l","+bl","+u"] . cycle $ [0] + +aSpcs :: [String] -> Args +aSpcs = fst . takeAsR aSpecs + +cSpecs1MA :: CLSpecifications +cSpecs1MA = [("+m",-1)] + +fstCharsMA :: FirstChars +fstCharsMA = ('+','-') + +bSpecs :: CLSpecifications +bSpecs = zip ["+d","+p","+s","+v"] . cycle $ [1] + +bSpcs :: [String] -> Args +bSpcs = fst . takeBsR bSpecs + +specs1 :: CLSpecifications +specs1 = aSpecs `mappend` bSpecs `mappend` cSpecs1MA diff --git a/Interpreter/StringConversion.hs b/Interpreter/StringConversion.hs --- a/Interpreter/StringConversion.hs +++ b/Interpreter/StringConversion.hs @@ -25,7 +25,7 @@ convStringInterpreter contrs xs | null contrs = xs | null . words $ xs = xs - | case filter (\y -> isDigit y || y == '/' || y == '-') contrs of { a:'/':bs -> a /= '/' && a /= '0' ; ~rrr -> False } = + | case filter (\y -> isDigit y || y == '/' || y == '-') contrs of { a:'/':bs -> a /= '/' && a /= '0' ; '1':'0':'/':cs -> True ; ~rrr -> False } = let ys = filter (\y -> isDigit y || y == '/' || y == '-') contrs in case ys of ~a:'/':bs -> let wordsN = words xs @@ -39,21 +39,32 @@ kss = drop 1 tss in if null wss then twoWords `mappend` (' ':unwords kss) else unwords wss `mappend` (' ':twoWords) `mappend` (' ':unwords kss) + '1':'0':'/':bs -> let wordsN = words xs + wordN = min 10 (length wordsN) + pos = fromMaybe 0 (readMaybe bs::Maybe Int) + wrdP = wordsN !! (min 9 (length wordsN - 1)) + (ts,us) | pos >= 0 = splitAt pos wrdP + | otherwise = splitAt (length wrdP + pos) wrdP + twoWords = ts `mappend` (' ':us) + (wss,tss) = splitAt 9 wordsN + kss = drop 1 tss in + unwords wss `mappend` (' ':twoWords) | length (filter (\t -> if (length . words $ xs) >= 10 then t >= '1' && t <= '9' else t >= '1' && [t] <= show (length . words $ xs)) $ contrs) < 2 = xs -- The following case is changed since the version 0.6.0.0 to support concatenations of the arbitrary two words, not needed to be consequent ones. | otherwise = let cntrs = (if take 1 (filter isDigit contrs) == "0" then "0" else []) `mappend` - (filter (\t -> if (length . words $ xs) >= 10 then t >= '1' && t <= '9' + (filter (\t -> if (length . words $ xs) >= 10 then t >= '0' && t <= '9' else t >= '1' && [t] <= show (length . words $ xs)) $ contrs) tss = words xs in case length cntrs of - 2 -> let pos = fromJust (readMaybe (take 1 cntrs)::Maybe Int) - number = fromJust (readMaybe (drop 1 cntrs)::Maybe Int) - (zss,yss) = splitAt (pos - 1) tss - (kss,lss) = splitAt number yss in - if length tss < pos + number - 1 then xs - else if null zss then concat kss `mappend` " " `mappend` unwords lss - else unwords zss `mappend` " " `mappend` concat kss `mappend` " " `mappend` unwords lss - _ -> let idxs = map (\x -> fromJust (readMaybe [x]::Maybe Int)) $ (if take 1 cntrs == "0" then drop 1 cntrs else cntrs) + 2 -> if take 1 cntrs == "0" then xs + else let pos = fromJust (readMaybe (take 1 cntrs)::Maybe Int) + number = fromJust (readMaybe (drop 1 cntrs)::Maybe Int) + (zss,yss) = splitAt (pos - 1) tss + (kss,lss) = splitAt number yss in + if length tss < pos + number - 1 then xs + else if null zss then concat kss `mappend` " " `mappend` unwords lss + else unwords zss `mappend` " " `mappend` concat kss `mappend` " " `mappend` unwords lss + _ -> let idxs = map (\x -> let k = fromJust (readMaybe [x]::Maybe Int) in if k == 0 then 10 else k) $ (if take 1 cntrs == "0" then drop 1 cntrs else cntrs) wordsN = map (\i -> tss !! (i - 1)) idxs restWords = tss \\ wordsN in unwords restWords `mappend` " " `mappend` concat wordsN @@ -63,7 +74,7 @@ convStringInterpreterIO contrs xs | null contrs = return xs | null . words $ xs = return xs - | case filter (\y -> isDigit y || y == '/' || y == '-') contrs of { a:'/':bs -> a /= '/' && a /= '0' ; ~rrr -> False } = + | case filter (\y -> isDigit y || y == '/' || y == '-') contrs of { a:'/':bs -> a /= '/' && a /= '0' ; '1':'0':'/':cs -> True ; ~rrr -> False } = let ys = filter (\y -> isDigit y || y == '/' || y == '-') contrs in case ys of ~a:'/':bs -> do @@ -74,20 +85,30 @@ if abs pos >= 8 then do corr pos wrdP >>= \pos2 -> correctionF pos2 wrdP wordN wordsN else correctionF pos wrdP wordN wordsN + '1':'0':'/':bs -> do + let wordsN = words xs + wordN = min 10 (length wordsN) + pos = fromMaybe 0 (readMaybe bs::Maybe Int) + wrdP = wordsN !! (min 9 (length wordsN - 1)) + if abs pos >= 8 then do + corr pos wrdP >>= \pos2 -> correctionF pos2 wrdP wordN wordsN + else correctionF pos wrdP wordN wordsN | length (filter (\t -> if (length . words $ xs) >= 10 then t >= '1' && t <= '9' else t >= '1' && [t] <= show (length . words $ xs)) $ contrs) < 2 = return xs | otherwise = let cntrs = (if take 1 (filter isDigit contrs) == "0" then "0" else []) `mappend` - (filter (\t -> if (length . words $ xs) >= 10 then t >= '1' && t <= '9' + (filter (\t -> if (length . words $ xs) >= 10 then t >= '0' && t <= '9' else t >= '1' && [t] <= show (length . words $ xs)) $ contrs) tss = words xs in case length cntrs of - 2 -> let pos = fromJust (readMaybe (take 1 cntrs)::Maybe Int) - number = fromJust (readMaybe (drop 1 cntrs)::Maybe Int) - (zss,yss) = splitAt (pos - 1) tss - (kss,lss) = splitAt number yss in - if length tss < pos + number - 1 then return xs - else if null zss then return (concat kss `mappend` " " `mappend` unwords lss) - else return (unwords zss `mappend` " " `mappend` concat kss `mappend` " " `mappend` unwords lss) - _ -> let idxs = map (\x -> fromJust (readMaybe [x]::Maybe Int)) $ (if take 1 cntrs == "0" then drop 1 cntrs else cntrs) + 2 -> if take 1 cntrs == "0" then return xs + else do + let pos = fromJust (readMaybe (take 1 cntrs)::Maybe Int) + number = fromJust (readMaybe (drop 1 cntrs)::Maybe Int) + (zss,yss) = splitAt (pos - 1) tss + (kss,lss) = splitAt number yss + if length tss < pos + number - 1 then return xs + else if null zss then return (concat kss `mappend` " " `mappend` unwords lss) + else return (unwords zss `mappend` " " `mappend` concat kss `mappend` " " `mappend` unwords lss) + _ -> let idxs = map (\x -> let k = fromJust (readMaybe [x]::Maybe Int) in if k == 0 then 10 else k) $ (if take 1 cntrs == "0" then drop 1 cntrs else cntrs) wordsN = map (\i -> tss !! (i - 1)) idxs restWords = tss \\ wordsN in return (unwords restWords `mappend` " " `mappend` concat wordsN) diff --git a/string-interpreter.cabal b/string-interpreter.cabal --- a/string-interpreter.cabal +++ b/string-interpreter.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: string-interpreter -version: 0.6.0.0 +version: 0.7.0.0 synopsis: Is used in the phonetic languages approach (e. g. in the recursive mode). description: A library that has commonly used functions for the phonetic-languages implementations that deals with String data. homepage: https://hackage.haskell.org/package/string-interpreter @@ -17,9 +17,9 @@ cabal-version: >=1.10 library - exposed-modules: Interpreter.StringConversion + exposed-modules: Interpreter.StringConversion, Interpreter.ArgsConversion -- other-modules: -- other-extensions: - build-depends: base >=4.8 && <5 + build-depends: base >=4.8 && <5, cli-arguments == 0.6.0.0, phonetic-languages-permutations-array == 0.3.4.0, phonetic-languages-basis == 0.2.0.0 -- hs-source-dirs: default-language: Haskell2010