{-# OPTIONS_HADDOCK show-extensions #-} -- | -- 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 import Data.Char (isDigit) import Data.List (sort,nub,intercalate,(\\)) import Data.Monoid (mappend) convStringInterpreter :: String -> String -> String convStringInterpreter contrs xs | null contrs = xs | null . words $ xs = xs | case filter (\y -> isDigit 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) (ts,us) = splitAt pos (wordsN !! (wordN - 1)) 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 (nub . filter (\t -> t >= '1' && [t] <= show (length . words $ xs)) $ contrs) < 2 = xs | otherwise = let cntrs = nub . filter (\t -> 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` intercalate " " 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