-- |
-- Module      :  Data.Phonetic.Languages.PrepareText
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to order the 7 or less phonetic language words (or their concatenations)
-- to obtain (to some extent) suitable for poetry or music text.
-- Earlier it has been a module DobutokO.Poetry.Ukrainian.PrepareText
-- from the @dobutokO-poetry@ package.
-- In particular, this module can be used to prepare the phonetic language text
-- by applying the most needed grammar to avoid misunderstanding
-- for the produced text. The attention is paid to the prepositions, pronouns, conjunctions
-- and particles that are most commonly connected (or not) in a significant way
-- with the next text.
-- Uses the information from:
-- https://uk.wikipedia.org/wiki/%D0%A1%D0%BF%D0%BE%D0%BB%D1%83%D1%87%D0%BD%D0%B8%D0%BA
-- and
-- https://uk.wikipedia.org/wiki/%D0%A7%D0%B0%D1%81%D1%82%D0%BA%D0%B0_(%D0%BC%D0%BE%D0%B2%D0%BE%D0%B7%D0%BD%D0%B0%D0%B2%D1%81%D1%82%D0%B2%D0%BE)
--
-- Uses arrays instead of vectors.
-- A list of basic (but, probably not complete and needed to be extended as needed) English words (the articles, pronouns,
-- particles, conjunctions etc.) the corresponding phonetic language translations of which are intended to be used as a
-- 'Concatenations' here is written to the file EnglishConcatenated.txt in the source tarball.

module Data.Phonetic.Languages.PrepareText (
  Concatenations
  -- * Basic functions
  , prepareText
  , prepareTextN
  , complexWords
  , splitLines
  , splitLinesN
  , isSpC
  , sort2Concat
  , toSequentialApp
  , prepareConcats
  , complexNWords
  -- * Used to transform after convertToProperphonetic language from mmsyn6ukr package
  , isPLL
) where

import CaseBi.Arr (getBFstL')
import Data.List.InnToOut.Basic (mapI)
import Data.Char (isAlpha,toLower)
import GHC.Arr
import Data.List (sort,sortOn)

-- | The lists in the list are sorted in the descending order by the word counts in the inner 'String's. All the 'String's
-- in each inner list have the same number of words, and if there is no 'String' with some intermediate number of words (e. g. there
-- are not empty 'String's for 4 and 2 words, but there is no one for 3 words 'String's) then such corresponding list is empty, but
-- it is, nevertheless, present. Probably the maximum number of words can be no more than 4, and the minimum number can be
-- probably no less than 1, but it depends (especially for the maximum). The 'String's in the inner lists must be (unlike the inner
-- lists themselves) sorted in the ascending order for the data type to work correctly in the functions of the module.
type Concatenations = [[String]]

-- | Is used to convert a phonetic language text into list of 'String' each of which is ready to be
-- used by the functions from the other modules in the package.
-- It applies minimal grammar links and connections between the most commonly used phonetic language
-- words that \"should\" be paired and not dealt with separately
-- to avoid the misinterpretation and preserve maximum of the semantics for the
-- \"phonetic\" language on the phonetic language basis.
prepareText
  :: [[String]] -- ^ Is intended to become a valid 'Concatenations'.
  -> String -- ^ A sorted 'String' of possible characters in the phonetic language representation.
  -> String
  -> [String]
prepareText :: [[String]] -> String -> String -> [String]
prepareText [[String]]
ysss String
xs = (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 (String -> Char -> Bool
isPLL String
xs)) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
splitLines ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String] -> [String]
complexNWords [[String]]
ysss ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
t -> Char -> Bool
isAlpha Char
t Bool -> Bool -> Bool
|| Char -> Bool
isSpC Char
t)) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

sort2Concat
 :: [[String]]
 -> 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.
sort2Concat :: [[String]] -> [[String]]
sort2Concat [[String]]
xsss
 | [[String]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[String]]
xsss = []
 | Bool
otherwise = ([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([[String]] -> [[String]])
-> ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
forall a. [a] -> [a]
reverse ([[String]] -> [[String]])
-> ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [Int]) -> [[String]] -> [[String]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)) ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [[String]]
xsss

toSequentialApp
 :: 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.
 -> [Concatenations]
toSequentialApp :: [[String]] -> [[[String]]]
toSequentialApp ysss :: [[String]]
ysss@([String]
xss:[[String]]
xsss)
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = [[String]] -> [[[String]]]
toSequentialApp [[String]]
xsss
 | Bool
otherwise = [[String]
xss, Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) []] [[String]] -> [[[String]]] -> [[[String]]]
forall a. a -> [a] -> [a]
: [[String]] -> [[[String]]]
toSequentialApp [[String]]
xsss
     where n :: Int
n = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> ([String] -> [String]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ [String]
xss
toSequentialApp [[String]]
_ = []

prepareConcats
 :: [[String]]
 -> [Concatenations]
prepareConcats :: [[String]] -> [[[String]]]
prepareConcats = [[String]] -> [[[String]]]
toSequentialApp ([[String]] -> [[[String]]])
-> ([[String]] -> [[String]]) -> [[String]] -> [[[String]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
sort2Concat
{-# INLINABLE prepareConcats #-}

{-| Applies the full complex words concatenations (opposite to the 'complexWords' that applies only partial concatenations). 
-}
complexNWords :: [[String]] -> [String] -> [String]
complexNWords :: [[String]] -> [String] -> [String]
complexNWords [[String]]
xsss [String]
yss = [[[String]]] -> [String] -> [String]
complexNWords' [[[String]]]
tssss [String]
yss
  where tssss :: [[[String]]]
tssss = [[String]] -> [[[String]]]
prepareConcats [[String]]
xsss
        complexNWords' :: [[[String]]] -> [String] -> [String]
complexNWords' tssss :: [[[String]]]
tssss@([[String]]
ysss:[[[String]]]
zssss) [String]
uss = [[[String]]] -> [String] -> [String]
complexNWords' [[[String]]]
zssss ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]] -> [String] -> [String]
complexWords [[String]]
ysss [[String]]
ysss ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
uss
        complexNWords' [[[String]]]
_ [String]
uss = [String]
uss

-- | Concatenates complex words in phonetic language so that they are not separated further by possible words order rearrangements (because they are treated
-- as a single word). This is needed to preserve basic grammar in phonetic languages.
complexWords :: Concatenations -> Concatenations -> [String] -> [String]
complexWords :: [[String]] -> [[String]] -> [String] -> [String]
complexWords [[String]]
rsss [[String]]
ysss [String]
zss
 = ((String, [[String]], [[String]]) -> String)
-> [(String, [[String]], [[String]])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
ts,[[String]]
_,[[String]]
_) -> String
ts) ([(String, [[String]], [[String]])] -> [String])
-> ([String] -> [(String, [[String]], [[String]])])
-> [String]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
 -> [(String, [[String]], [[String]])]
 -> [(String, [[String]], [[String]])])
-> [(String, [[String]], [[String]])]
-> [String]
-> [(String, [[String]], [[String]])]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String
-> [(String, [[String]], [[String]])]
-> [(String, [[String]], [[String]])]
f [(String, [[String]], [[String]])]
forall a. [([a], [[String]], [[String]])]
v ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
zss
    where v :: [([a], [[String]], [[String]])]
v = [([],[[String]]
rsss,[[String]]
ysss)]
          f :: String
-> [(String, [[String]], [[String]])]
-> [(String, [[String]], [[String]])]
f String
z rs :: [(String, [[String]], [[String]])]
rs@((String
t,[[String]]
rsss,([String]
yss:[[String]]
tsss)):[(String, [[String]], [[String]])]
ks)
            | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
yss = String
-> [(String, [[String]], [[String]])]
-> [(String, [[String]], [[String]])]
f String
z ((String
t,[[String]]
rsss,[[String]]
tsss)(String, [[String]], [[String]])
-> [(String, [[String]], [[String]])]
-> [(String, [[String]], [[String]])]
forall a. a -> [a] -> [a]
:[(String, [[String]], [[String]])]
ks)
            | Bool -> [(String, Bool)] -> String -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Bool
False ([String] -> [Bool] -> [(String, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
yss ([Bool] -> [(String, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(String, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
10000 (Bool -> [(String, Bool)]) -> Bool -> [(String, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) String
uwxs = ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') String
uwxs String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
t,[[String]]
rsss,[[String]]
rsss)(String, [[String]], [[String]])
-> [(String, [[String]], [[String]])]
-> [(String, [[String]], [[String]])]
forall a. a -> [a] -> [a]
:[(String, [[String]], [[String]])]
ks
            | Bool
otherwise = String
-> [(String, [[String]], [[String]])]
-> [(String, [[String]], [[String]])]
f String
z ((String
t,[[String]]
rsss,[[String]]
tsss)(String, [[String]], [[String]])
-> [(String, [[String]], [[String]])]
-> [(String, [[String]], [[String]])]
forall a. a -> [a] -> [a]
:[(String, [[String]], [[String]])]
ks)
                  where y :: Int
y = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> ([String] -> [String]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ [String]
yss
                        uwxs :: String
uwxs = [String] -> String
unwords ([String] -> String)
-> ([(String, [[String]], [[String]])] -> [String])
-> [(String, [[String]], [[String]])]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
y ([String] -> [String])
-> ([(String, [[String]], [[String]])] -> [String])
-> [(String, [[String]], [[String]])]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [[String]], [[String]]) -> String)
-> [(String, [[String]], [[String]])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
q,[[String]]
_,[[String]]
_) -> String
q) ([(String, [[String]], [[String]])] -> String)
-> [(String, [[String]], [[String]])] -> String
forall a b. (a -> b) -> a -> b
$ [(String, [[String]], [[String]])]
rs
          f String
z rs :: [(String, [[String]], [[String]])]
rs@((String
t,[[String]]
rsss,[]):[(String, [[String]], [[String]])]
ks) = (String
z,[[String]]
rsss,[[String]]
rsss)(String, [[String]], [[String]])
-> [(String, [[String]], [[String]])]
-> [(String, [[String]], [[String]])]
forall a. a -> [a] -> [a]
:[(String, [[String]], [[String]])]
rs

-- | A generalized variant of the 'prepareText' with the arbitrary maximum number of the words in the lines given as the first argument.
prepareTextN
 :: Int -- ^ A maximum number of the words or their concatenations in the resulting list of 'String's.
 -> [[String]] -- ^ Is intended to become a valid 'Concatenations'.
 -> String -- ^ A sorted 'String' of possible characters in the phonetic language representation.
 -> String
 -> [String]
prepareTextN :: Int -> [[String]] -> String -> String -> [String]
prepareTextN Int
n [[String]]
ysss String
xs = (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 (String -> Char -> Bool
isPLL String
xs)) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
splitLinesN Int
n ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String] -> [String]
complexNWords [[String]]
ysss ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
t -> Char -> Bool
isAlpha Char
t Bool -> Bool -> Bool
|| Char -> Bool
isSpC Char
t)) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

-- | A predicate to check whether the given character is one of the \"\' \\x2019\\x02BC-\".
isSpC :: Char -> Bool
isSpC :: Char -> Bool
isSpC Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x2019' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x02BC' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
{-# INLINE isSpC #-}

-- | The first argument must be a 'String' of sorted 'Char's in the ascending order of all possible symbols that can be
-- used for the text in the phonetic language selected. Can be prepared beforehand, or read from the file. 
isPLL :: String -> Char -> Bool
isPLL :: String -> Char -> Bool
isPLL String
xs Char
y = Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Bool
False (String -> [Bool] -> [(Char, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
xs ([Bool] -> [(Char, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(Char, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
10000 (Bool -> [(Char, Bool)]) -> Bool -> [(Char, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Char
y

-- | The function is recursive and is applied so that all returned elements ('String') are no longer than 7 words in them.
splitLines :: [String] -> [String]
splitLines :: [String] -> [String]
splitLines [String]
xss
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = []
 | Bool
otherwise = (String -> Bool) -> (String -> [String]) -> [String] -> [String]
forall a. (a -> Bool) -> (a -> [a]) -> [a] -> [a]
mapI (\String
xs -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
xs) Int
7 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (\String
xs -> let yss :: [String]
yss = String -> [String]
words String
xs in
     [String] -> [String]
splitLines ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords ([[String]] -> [String])
-> ([String] -> [[String]]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([String]
q,[String]
r) -> [[String]
q,[String]
r]) (([String], [String]) -> [[String]])
-> ([String] -> ([String], [String])) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
yss Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
yss) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
xss

-- | A generalized variant of the 'splitLines' with the arbitrary maximum number of the words in the lines given as the first argument.
splitLinesN :: Int -> [String] -> [String]
splitLinesN :: Int -> [String] -> [String]
splitLinesN Int
n [String]
xss
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
 | Bool
otherwise = (String -> Bool) -> (String -> [String]) -> [String] -> [String]
forall a. (a -> Bool) -> (a -> [a]) -> [a] -> [a]
mapI (\String
xs -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
xs) Int
n Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (\String
xs -> let yss :: [String]
yss = String -> [String]
words String
xs in
     [String] -> [String]
splitLines ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords ([[String]] -> [String])
-> ([String] -> [[String]]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([String]
q,[String]
r) -> [[String]
q,[String]
r]) (([String], [String]) -> [[String]])
-> ([String] -> ([String], [String])) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
yss Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
yss) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
xss