{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}
-- |
-- Module : Phonetic.Languages.Common
-- Copyright : (c) OleksandrZhabenko 2020
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
--
--
module Phonetic.Languages.Common (
fLines
, fLinesIO
) where
import Data.SubG (subG)
import Melodics.ByteString.Ukrainian.Arr (isUkrainianL)
import Phonetic.Languages.Ukrainian.PrepareText
import Data.Char (isAlpha)
fLines :: Int -> String -> [String]
fLines !toOneLine ys =
let preText = filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareText . (\z -> if toOneLine == 1 then unwords . words $ z else z) $ ys
wss = map (length . subG " 01-") preText
in helpG2 preText wss
helpG2 (t:ts) (r:rs)
| r > 7 = filter (`notElem` "01-") t:helpG2 ts rs
| otherwise = t:helpG2 ts rs
helpG2 _ _ = []
fLinesIO :: String -> IO ()
fLinesIO ys =
let preText = filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareText $ ys
wss = map (length . subG " 01-") preText
in mapM_ putStrLn . map (\(i,x) -> show (i + 1) ++ "\t" ++ x) . helpG3 . indexedL "" . helpG2 preText $ wss
-- | Is taken mostly from the Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG module from the @phonetic-languages-simplified-common@ package.
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