-- | -- Module : Main -- Copyright : (c) OleksandrZhabenko 2020 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- Inspired by: https://functional-art.org/2020/papers/Poetry-OleksandrZhabenko.pdf from the https://functional-art.org/2020/performances ; -- Allows to rewrite the given text (usually a poetical one). module Main where import qualified Data.Vector as V import Data.List (intercalate,intersperse) import System.IO import String.Languages.UniquenessPeriods.Vector import Languages.UniquenessPeriods.Vector.General.Debug import Languages.UniquenessPeriods.Vector.Properties import Melodics.Ukrainian import System.Environment import Languages.Phonetic.Ukrainian.PrepareText import Languages.UniquenessPeriods.Vector.Data import Languages.UniquenessPeriods.Vector.Auxiliary main :: IO () main = do args <- getArgs let file = concat . take 1 $ args contents <- readFile file let flines = prepareText contents lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines zs = lastFrom3 . headU2 . fst . get22 . uniqNProperties2GN " 01-" (PA [] (concat . take 1 $ lasts)) 1 1 (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) . unwords . init . words . concat . take 1 $ flines toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2 (concat . take 1 $ lasts) . drop 1 $ flines)) circle2 :: String -> [String] -> [String] circle2 xs xss | null xss = [] | otherwise = let (zss,tss) = splitAt 1 xss in do let rs = words . concat $ zss ws = lastFrom3 . headU2 . fst . get22 . uniqNProperties2GN " 01-" (PA xs (if null rs then [] else last rs)) 1 1 (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) . unwords $ if null rs then [] else init rs in ws:circle2 (if null rs then [] else last rs) tss headU2 :: [UniquenessG1 a b] -> UniquenessG1 a b headU2 zs | null zs = ([],V.empty,[]) | otherwise = head zs noDoubleWords :: [String] -> [String] noDoubleWords xss = map (unwords . drop 1 . words) xss -- | Auxiliary printing function to define the line ending needed to be printed by 'printUniquenessG1List' function in some cases. newLineEnding :: String newLineEnding | nativeNewline == LF = "\n" | otherwise = "\r\n"