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