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

-- |
-- Module      :  Phonetic.Languages.General.Common
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- 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 (
  fLinesN
  , fLines
  , fLinesNIO
  , fLinesIO
) where

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

fLinesN
 :: Int
 -> Concatenations -- ^ Data used to concatenate (prepend) 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.
 -> Concatenations -- ^ Data used to concatenate (append) 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]
fLinesN :: Int
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> Int
-> String
-> [String]
fLinesN Int
n Concatenations
ysss Concatenations
zsss String
xs String
us String
vs !Int
toOneLine String
ys = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
x -> String -> Char -> Bool
isPLL String
xs Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
x)) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Concatenations -> Concatenations -> String -> String -> [String]
prepareTextN Int
n Concatenations
ysss Concatenations
zsss String
xs (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (\String
z -> if Int
toOneLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String -> String
unls String
z else String
z) (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
ys
           -- the 'unls' is taken from the 'Data.List.words' and rewritten to be equal to 'unwords' . 'words'
           where unls :: String -> String
unls String
s  =  case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
us String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
vs)) String
s of
                             String
"" -> []
                             String
s' -> String
w String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` (Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unls String
s'')
                                where (String
w, String
s'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
us String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
vs)) String
s'

fLines
 :: Concatenations -- ^ Data used to concatenate (prepend) 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.
 -> Concatenations -- ^ Data used to concatenate (append) 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 :: Concatenations
-> Concatenations
-> String
-> String
-> String
-> Int
-> String
-> [String]
fLines = Int
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> Int
-> String
-> [String]
fLinesN Int
7
{-# INLINE fLines #-}

fLinesNIO
 :: Int
 -> Concatenations -- ^ Data used to concatenate (prepend) 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.
 -> Concatenations -- ^ Data used to concatenate (append) 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 ()
fLinesNIO :: Int
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> String
-> IO ()
fLinesNIO Int
n Concatenations
ysss Concatenations
zsss String
xs String
us String
vs String
ys = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn ([String] -> IO ()) -> (String -> [String]) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,String
x) -> Int -> String
forall a. Show a => a -> String
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) ([(Int, String)] -> [String])
-> (String -> [(Int, String)]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, String)] -> [(Int, String)]
forall a. [a] -> [a]
helpG3 ([(Int, String)] -> [(Int, String)])
-> (String -> [(Int, String)]) -> String -> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [(Int, String)]
forall (t :: * -> *) b. Foldable t => b -> t b -> [(Int, b)]
indexedL String
"" ([String] -> [(Int, String)])
-> (String -> [String]) -> String -> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
x -> String -> Char -> Bool
isPLL String
xs Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
x)) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Concatenations -> Concatenations -> String -> String -> [String]
prepareTextN Int
n Concatenations
ysss Concatenations
zsss String
xs (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
ys

fLinesIO
 :: Concatenations -- ^ Data used to concatenate (prepend) 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.
 -> Concatenations -- ^ Data used to concatenate (append) 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 :: Concatenations
-> Concatenations -> String -> String -> String -> String -> IO ()
fLinesIO = Int
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> String
-> IO ()
fLinesNIO Int
7
{-# INLINE fLinesIO #-}

-- | Indexes the 'Foldable' structure using consequential 'Int' values.
indexedL :: Foldable t => b -> t b -> [(Int, b)]
indexedL :: b -> t b -> [(Int, b)]
indexedL b
y t b
zs = (b -> [(Int, b)] -> [(Int, b)]) -> [(Int, b)] -> t b -> [(Int, b)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> [(Int, b)] -> [(Int, b)]
forall a b. Num a => b -> [(a, b)] -> [(a, b)]
f [(Int, b)]
v t b
zs
  where !v :: [(Int, b)]
v = [(t b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t b
zs,b
y)]
        f :: b -> [(a, b)] -> [(a, b)]
f b
x ((a
j,b
z):[(a, b)]
ys) = (a
ja -> a -> a
forall a. Num a => a -> a -> a
-a
1,b
x)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:(a
j,b
z)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
ys
{-# INLINE indexedL #-}

helpG3 :: [a] -> [a]
helpG3 :: [a] -> [a]
helpG3 [a]
xs
 | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs = []
 | Bool
otherwise = [a] -> [a]
forall a. [a] -> [a]
init [a]
xs