{-# 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 #-}