Common.hs

{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}

-- |
-- Module      :  Phonetic.Languages.General.Common
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Is rewritten from the module Phonetic.Languages.Common from the package @phonetic-languages-simplified-examples-common@.
--

module Phonetic.Languages.General.Common (
  fLines
  , fLinesIO
) where

import Data.SubG (subG)
import Data.Phonetic.Languages.PrepareText
import Data.Char (isAlpha)
import Data.Monoid (mappend)

fLines :: Concatenations -> String -> String -> String -> Int -> String -> [String]
fLines ysss xs us vs !toOneLine ys =
  let preText = filter (any (\x -> isPLL xs x && isAlpha x)) . prepareText ysss xs .
         (\z -> if toOneLine == 1 then unwords . words $ z else z) $ ys
      wss = map (length . subG (' ':us `mappend` vs)) preText
        in helpG2 us vs preText wss

helpG2 us vs (t:ts) (r:rs)
 | r > 7 = filter (`notElem` (us `mappend` vs)) t:helpG2 us vs ts rs
 | otherwise = t:helpG2 us vs ts rs
helpG2 _ _ _ _ = []

fLinesIO :: Concatenations -> String -> String -> String -> String -> IO ()
fLinesIO ysss xs us vs ys =
  let preText = filter (any (\x -> isPLL xs x && isAlpha x)) . prepareText ysss xs $ ys
      wss = map (length . subG (' ':us `mappend` vs)) preText
        in mapM_ putStrLn . map (\(i,x) -> show (i + 1) ++ "\t" ++ x) . helpG3 . indexedL "" . helpG2 us vs preText $ wss

-- | 
indexedL :: Foldable t => b -> t b -> [(Int, b)]
indexedL y zs = foldr f v zs
  where !v = [(length zs,y)]
        f x ((j,z):ys) = (j-1,x):(j,z):ys
{-# INLINE indexedL #-}

helpG3 :: [a] -> [a]
helpG3 xs
 | null xs = []
 | otherwise = init xs