string-interpreter-0.3.0.0: Interpreter/StringConversion.hs

{-# 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 (fromJust,fromMaybe)
import Data.Char (isDigit)
import Data.List (sort,nub,(\\))
import Data.Monoid (mappend)

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 (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` 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