string-interpreter-0.7.0.0: Interpreter/StringConversion.hs
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module : Interpreter.StringConversion
-- Copyright : (c) OleksandrZhabenko 2021-2022
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- A library that has commonly used function for the phonetic-languages implementations.
module Interpreter.StringConversion where
import Text.Read (readMaybe)
import Data.Maybe (fromJust,fromMaybe)
import Data.Char (isDigit)
import Data.List (sort,(\\))
import Data.Monoid (mappend)
import Control.Exception
{-| Converts the second given string into the form that can be easily used by the phonetic-languages-simplified-* implementations. -}
convStringInterpreter :: String -> String -> String
convStringInterpreter contrs xs
| null contrs = xs
| null . words $ xs = xs
| 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
wordN = min (fromMaybe 1 (readMaybe [a]::Maybe Int)) (length wordsN)
pos = fromMaybe 0 (readMaybe bs::Maybe Int)
wrdP = wordsN !! (wordN - 1)
(ts,us) | pos >= 0 = splitAt pos wrdP
| otherwise = splitAt (length wrdP + pos) wrdP
twoWords = ts `mappend` (' ':us)
(wss,tss) = splitAt (wordN - 1) wordsN
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 >= '0' && t <= '9'
else t >= '1' && [t] <= show (length . words $ xs)) $ contrs)
tss = words xs in
case length cntrs of
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
{-| Variant of the 'convStringInterpreter' with the additional possibility to correct splitting after revision. -}
convStringInterpreterIO :: String -> String -> IO String
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' ; '1':'0':'/':cs -> True ; ~rrr -> False } =
let ys = filter (\y -> isDigit y || y == '/' || y == '-') contrs in
case ys of
~a:'/':bs -> do
let wordsN = words xs
wordN = min (fromMaybe 1 (readMaybe [a]::Maybe Int)) (length wordsN)
pos = fromMaybe 0 (readMaybe bs::Maybe Int)
wrdP = wordsN !! (wordN - 1)
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 >= '0' && t <= '9'
else t >= '1' && [t] <= show (length . words $ xs)) $ contrs)
tss = words xs in
case length cntrs of
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)
corr :: Int -> String -> IO Int
corr pos wrdP = do
let (ts, us) | pos >= 0 = splitAt pos wrdP
| otherwise = splitAt (length wrdP + pos) wrdP
twoWords = ts `mappend` (' ':us)
putStrLn $ "?: " `mappend` twoWords
llls <- getLine
if null llls then return pos
else do
let tss = words llls
wrd0 = fromMaybe 1 (readMaybe (concat . take 1 $ tss)::Maybe Int)
posN = fromMaybe 0 (readMaybe (concat . drop 1 . take 2 $ tss)::Maybe Int)
case wrd0 of
1 -> corr (pos - posN) wrdP
2 -> corr (pos + posN) wrdP
_ -> corr pos wrdP
correctionF :: Monad m => Int -> String -> Int -> [String] -> m String
correctionF pos wrdP wordN wordsN = do
let (ts,us) | pos >= 0 = splitAt pos wrdP
| otherwise = splitAt (length wrdP + pos) wrdP
twoWords = ts `mappend` (' ':us)
(wss,tss) = splitAt (wordN - 1) wordsN
kss = drop 1 tss
if null wss then return (twoWords `mappend` (' ':unwords kss))
else return (unwords wss `mappend` (' ':twoWords) `mappend` (' ':unwords kss))
{-| Inspired by: 'https://hackage.haskell.org/package/base-4.15.0.0/docs/src/GHC-IO.html#catch'
Reads a textual file given by its 'FilePath' and returns its contents lazily. If there is
some 'IOException' thrown or an empty file then returns just "". Raises an exception for the binary file. -}
readFileIfAny :: FilePath -> IO String
readFileIfAny file = catch (readFile file) (\(e :: IOException) -> return "")
-------------------------------------------------------------
argsConvertTextual :: String -> [String] -> [String]
argsConvertTextual ts tss
| any (== ts) tss = tss
| otherwise = tss `mappend` [ts]
{-# INLINE argsConvertTextual #-}
fullArgsConvertTextual
:: (String -> Bool) -- ^ The predicate that checks whether the given argument is not a phonetic language word in the representation.
-> String
-> String
-> [String]
-> [String]
fullArgsConvertTextual p textProcessment0 lineA args =
argsConvertTextual textProcessment0 (takeWhile p args `mappend` words lineA)
{-# INLINE fullArgsConvertTextual #-}
-------------------------------------------------------------
fullArgsConvertTextualSimple
:: (String -> Bool) -- ^ The predicate that checks whether the given argument is not a phonetic language word in the representation.
-> String
-> [String]
-> [String]
fullArgsConvertTextualSimple p lineA args = takeWhile p args `mappend` words lineA
{-# INLINE fullArgsConvertTextualSimple #-}