{-# 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.Phonetic.Languages.PrepareText import Data.Char (isAlpha) import Data.Monoid (mappend) fLines :: Concatenations -- ^ Data used to concatenate the basic grammar preserving words and word sequences to the next word to -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. -> String -> String -> String -> Int -> String -> [String] fLines ysss xs us vs !toOneLine ys = filter (any (\x -> isPLL xs x && isAlpha x)) . prepareText ysss xs . (\z -> if toOneLine == 1 then unls z else z) $ ys -- the 'unls' is taken from the 'Data.List.words' and rewritten to be equal to 'unwords' . 'words' where unls s = case dropWhile (`elem` (' ':us `mappend` vs)) s of "" -> [] s' -> w `mappend` (' ' : unls s'') where (w, s'') = break (`elem` (' ':us `mappend` vs)) s' fLinesIO :: Concatenations -- ^ Data used to concatenate the basic grammar preserving words and word sequences to the next word to -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. -> String -> String -> String -> String -> IO () fLinesIO ysss xs us vs ys = mapM_ putStrLn . map (\(i,x) -> show (i + 1) ++ "\t" ++ x) . helpG3 . indexedL "" . filter (any (\x -> isPLL xs x && isAlpha x)) . prepareText ysss xs $ ys -- | Indexes the 'Foldable' structure using consequential 'Int' values. 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