{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module : Interpreter.StringConversion
-- Copyright : (c) OleksandrZhabenko 2021
-- 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' ; ~rrr -> False } =
let ys = filter (\y -> isDigit 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)
| length (filter (\t -> if (length . words $ xs) >= 10 then t >= '1' && t <= '9' else t >= '1' && [t] <= show (length . words $ xs)) $ contrs) < 2 = xs
| otherwise = let cntrs = filter (\t -> if (length . words $ xs) >= 10 then t >= '1' && 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)) $ cntrs
wordsN = map (\i -> tss !! (i - 1)) idxs
restWords = tss \\ wordsN
in unwords restWords `mappend` " " `mappend` concat wordsN
{-| 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 #-}