string-interpreter 0.6.0.0 → 0.7.0.0
raw patch · 4 files changed
+112/−23 lines, 4 filesdep +cli-argumentsdep +phonetic-languages-basisdep +phonetic-languages-permutations-array
Dependencies added: cli-arguments, phonetic-languages-basis, phonetic-languages-permutations-array
Files
- ChangeLog.md +4/−0
- Interpreter/ArgsConversion.hs +64/−0
- Interpreter/StringConversion.hs +41/−20
- string-interpreter.cabal +3/−3
ChangeLog.md view
@@ -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.
+ Interpreter/ArgsConversion.hs view
@@ -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
Interpreter/StringConversion.hs view
@@ -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)
string-interpreter.cabal view
@@ -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