-- |
-- Module      :  System.Process.Sequential
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- This library is intended to be a testsuite for some recursive multi file multiprocessment using some system executable
-- that processes multiple files creating the resulting one (the \"sox\" can be a good example).
-- 
-- The purposes are to avoid leakage of resources if the
-- number of files are too great to be processed at once, to use multiple sequential processment schemes for the same
-- executable and to create to some extent complex processment environment. Nevertheless, there is no guarantees that
-- the test will be successful and such an environment can be created using such a scheme. Please, do not use at the moment
-- in the production without additional thorough testing.

module System.Process.Sequential where

import Data.List (isPrefixOf)
import Data.Maybe (mapMaybe, fromJust)
import Data.Monoid (mappend)
import System.Process (readProcessWithExitCode)
import System.Directory (listDirectory,doesFileExist,removeFile)
import System.Exit (ExitCode(..))
import EndOfExe (showE)
import Sublists (intoRegularSublists)

seqFlsReadProcessWithExitCode
  :: FilePath -- ^ A name of the executable that must be available inside the variable PATH.
  -> Int -- ^ A limiting parameter for the number of cycles.
  -> (String -> String) -- ^ A function to convert the name of the files in the current directory that are sequentially processed.
  -> String -- ^ A needed symbol sequence to be found firstly to filter the needed files to be processed by the first recursion pass.
  -> [Int] -- ^ A list of the length of the needed file sequences for the 'intoRegularSublists' function.
  -> ([Int] -> [Int]) -- ^ A function to change the previous parameter at the each step of recursive call.
  -> ([String] -> Int -> [String]) -- ^ A function to change the list of arguments applied after the file names as command line arguments for the executable. An 'Int' is used to additionally control the processment.
  -> [String] -- ^ A list of the first pass command line arguments for the executable after the file names.
  -> String -- ^ A parameter for the 'readProcessWithExitCode' -- the last one. Is often [].
  -> IO ([FilePath],[Int],[String],Int) -- ^ The result to be obtained if the processment is successful.
seqFlsReadProcessWithExitCode :: FilePath
-> Int
-> (FilePath -> FilePath)
-> FilePath
-> [Int]
-> ([Int] -> [Int])
-> ([FilePath] -> Int -> [FilePath])
-> [FilePath]
-> FilePath
-> IO ([FilePath], [Int], [FilePath], Int)
seqFlsReadProcessWithExitCode FilePath
executable Int
limK FilePath -> FilePath
f FilePath
searchNeedle1 [Int]
ns [Int] -> [Int]
g_N [FilePath] -> Int -> [FilePath]
h_S [FilePath]
xss FilePath
ys = do
  [FilePath]
ends1 <- FilePath
-> (FilePath -> FilePath)
-> FilePath
-> [Int]
-> [FilePath]
-> FilePath
-> IO [FilePath]
seqFlsReadProcessWithExitCode1 FilePath
executable FilePath -> FilePath
f FilePath
searchNeedle1 [Int]
ns [FilePath]
xss FilePath
ys
  FilePath
-> Int
-> (FilePath -> FilePath)
-> [FilePath]
-> [Int]
-> ([Int] -> [Int])
-> ([FilePath] -> Int -> [FilePath])
-> [FilePath]
-> FilePath
-> IO ([FilePath], [Int], [FilePath], Int)
recursiveApplyFGH FilePath
executable (Int
limK Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) FilePath -> FilePath
f [FilePath]
ends1 ([Int] -> [Int]
g_N [Int]
ns) [Int] -> [Int]
g_N [FilePath] -> Int -> [FilePath]
h_S ([FilePath] -> Int -> [FilePath]
h_S [FilePath]
xss (Int
limK Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) FilePath
ys

seqFlsReadProcessWithExitCode1
  :: FilePath -- ^ A name of the executable that must be available inside the variable PATH.
  -> (String -> String) -- ^ A function to convert the name of the files in the current directory that are sequentially processed.
  -> String -- ^ A needed symbol sequence to be found firstly to filter the needed files to be processed by the first recursion pass.
  -> [Int] -- ^ A list of the length of the needed file sequences for the 'intoRegularSublists' function.
  -> [String] -- ^ A list of the first pass command line arguments for the executable after the file names.
  -> String -- ^ A parameter for the 'readProcessWithExitCode' -- the last one. Is often [].
  -> IO [FilePath] -- ^ The result to be obtained if the processment is successful.
seqFlsReadProcessWithExitCode1 :: FilePath
-> (FilePath -> FilePath)
-> FilePath
-> [Int]
-> [FilePath]
-> FilePath
-> IO [FilePath]
seqFlsReadProcessWithExitCode1 FilePath
executable FilePath -> FilePath
f FilePath
searchNeedle [Int]
ns [FilePath]
xss FilePath
ys = do
  [FilePath]
dir <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
  let zss :: [FilePath]
zss = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
searchNeedle) [FilePath]
dir
      yss :: [[FilePath]]
yss = ([FilePath] -> Bool) -> [[FilePath]] -> [[FilePath]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([FilePath] -> Bool) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[FilePath]] -> [[FilePath]])
-> ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [FilePath] -> [[FilePath]]
forall a. [Int] -> [a] -> [[a]]
intoRegularSublists [Int]
ns ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$ [FilePath]
zss
      ends1 :: [FilePath]
ends1 = ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
f (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. [a] -> a
last) [[FilePath]]
yss
      y1ss :: [[FilePath]]
y1ss = ([FilePath] -> FilePath -> [FilePath])
-> [[FilePath]] -> [FilePath] -> [[FilePath]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[FilePath]
xss FilePath
rs -> [FilePath]
xss [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
rs]) [[FilePath]]
yss [FilePath]
ends1
  ([FilePath] -> IO ExitCode) -> [[FilePath]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[FilePath]
uss -> FilePath -> [FilePath] -> [FilePath] -> FilePath -> IO ExitCode
seqFlsHelp1 FilePath
executable [FilePath]
uss [FilePath]
xss FilePath
ys) [[FilePath]]
y1ss
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
ends1

seqFlsReadProcessWithExitCode0
  :: FilePath -- ^ A name of the executable that must be available inside the variable PATH.
  -> (String -> String) -- ^ A function to convert the name of the files in the current directory that are sequentially processed.
  -> [Int] -- ^ A list of the length of the needed file sequences for the 'intoRegularSublists' function.
  -> [FilePath] -- ^ A list of the files that are processed (the existing ones plus the new one in that order).
  -> [String] -- ^ A list of the first pass command line arguments for the executable after the file names.
  -> String -- ^ A parameter for the 'readProcessWithExitCode' -- the last one. Is often [].
  -> IO ([FilePath],[Int],[String]) -- ^ The result to be obtained if the processment is successful.
seqFlsReadProcessWithExitCode0 :: FilePath
-> (FilePath -> FilePath)
-> [Int]
-> [FilePath]
-> [FilePath]
-> FilePath
-> IO ([FilePath], [Int], [FilePath])
seqFlsReadProcessWithExitCode0 FilePath
executable FilePath -> FilePath
f [Int]
ns [FilePath]
zss [FilePath]
xss FilePath
ys = do
  let yss :: [[FilePath]]
yss = ([FilePath] -> Bool) -> [[FilePath]] -> [[FilePath]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([FilePath] -> Bool) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[FilePath]] -> [[FilePath]])
-> ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [FilePath] -> [[FilePath]]
forall a. [Int] -> [a] -> [[a]]
intoRegularSublists [Int]
ns ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$ [FilePath]
zss
      ends1 :: [FilePath]
ends1 = ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
f (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. [a] -> a
last) [[FilePath]]
yss
      y1ss :: [[FilePath]]
y1ss = ([FilePath] -> FilePath -> [FilePath])
-> [[FilePath]] -> [FilePath] -> [[FilePath]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[FilePath]
xss FilePath
rs -> [FilePath]
xss [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
rs]) [[FilePath]]
yss [FilePath]
ends1
  ([FilePath] -> IO ExitCode) -> [[FilePath]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[FilePath]
uss -> FilePath -> [FilePath] -> [FilePath] -> FilePath -> IO ExitCode
seqFlsHelp1 FilePath
executable [FilePath]
uss [FilePath]
xss FilePath
ys) [[FilePath]]
y1ss
  ([FilePath], [Int], [FilePath])
-> IO ([FilePath], [Int], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
ends1, [Int]
ns, [FilePath]
xss)

recursiveApplyFGH
  :: FilePath -- ^ A name of the executable that must be available inside the variable PATH.
  -> Int -- ^ A limiting parameter for the number of cycles.
  -> (String -> String) -- ^ A function to convert the name of the files in the current directory that are sequentially processed.
  -> [FilePath] -- ^ A list of the files that are processed (the existing ones plus the new one in that order).
  -> [Int] -- ^ A list of the length of the needed file sequences for the 'intoRegularSublists' function.
  -> ([Int] -> [Int]) -- ^ A function to change the previous parameter at the each step of recursive call.
  -> ([String] -> Int -> [String]) -- ^ A function to change the list of arguments applied after the file names as command line arguments for the executable. An 'Int' is used to additionally control the processment.
  -> [String] -- ^ A list of the first pass command line arguments for the executable after the file names.
  -> String -- ^ A parameter for the 'readProcessWithExitCode' -- the last one. Is often [].
  -> IO ([FilePath],[Int],[String],Int) -- ^ The result to be obtained if the processment is successful.
recursiveApplyFGH :: FilePath
-> Int
-> (FilePath -> FilePath)
-> [FilePath]
-> [Int]
-> ([Int] -> [Int])
-> ([FilePath] -> Int -> [FilePath])
-> [FilePath]
-> FilePath
-> IO ([FilePath], [Int], [FilePath], Int)
recursiveApplyFGH FilePath
executable Int
limK FilePath -> FilePath
f [FilePath]
zss [Int]
ns [Int] -> [Int]
g_N [FilePath] -> Int -> [FilePath]
h_S [FilePath]
xss FilePath
ys
 | Int
limK Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
  ([FilePath]
ends1, [Int]
ns, [FilePath]
xss) <- FilePath
-> (FilePath -> FilePath)
-> [Int]
-> [FilePath]
-> [FilePath]
-> FilePath
-> IO ([FilePath], [Int], [FilePath])
seqFlsReadProcessWithExitCode0 FilePath
executable FilePath -> FilePath
f [Int]
ns [FilePath]
zss [FilePath]
xss FilePath
ys
  let newNs :: [Int]
newNs = [Int] -> [Int]
g_N [Int]
ns
      newXss :: [FilePath]
newXss = [FilePath] -> Int -> [FilePath]
h_S [FilePath]
xss (Int
limK Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  FilePath
-> Int
-> (FilePath -> FilePath)
-> [FilePath]
-> [Int]
-> ([Int] -> [Int])
-> ([FilePath] -> Int -> [FilePath])
-> [FilePath]
-> FilePath
-> IO ([FilePath], [Int], [FilePath], Int)
recursiveApplyFGH FilePath
executable (Int
limK Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) FilePath -> FilePath
f [FilePath]
ends1 [Int]
newNs [Int] -> [Int]
g_N [FilePath] -> Int -> [FilePath]
h_S [FilePath]
newXss FilePath
ys
 | Bool
otherwise = ([FilePath], [Int], [FilePath], Int)
-> IO ([FilePath], [Int], [FilePath], Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
zss, [Int]
ns, [FilePath]
xss, Int
limK)

seqFlsHelp1
  :: FilePath -- ^ A name of the executable that must be available inside the variable PATH.
  -> [FilePath] -- ^ A list of the files that are processed (the existing ones plus the new one in that order).
  -> [String] -- ^ A list of the first pass command line arguments for the executable after the file names.
  -> String -- ^ A parameter for the 'readProcessWithExitCode' -- the last one. Is often [].
  -> IO ExitCode -- ^ The result to be obtained. 'ExitSuccess' means that the processment was successful.
seqFlsHelp1 :: FilePath -> [FilePath] -> [FilePath] -> FilePath -> IO ExitCode
seqFlsHelp1 FilePath
executable [FilePath]
files [FilePath]
args FilePath
poststr = do
  (ExitCode
code,FilePath
hout,FilePath
herr) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
executable)) ([FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. Monoid a => a -> a -> a
`mappend` [FilePath]
args) FilePath
poststr
  case ExitCode
code of
    ExitCode
ExitSuccess -> FilePath -> IO ()
putStr FilePath
hout
    ExitCode
_ -> do
      Bool
exi <- FilePath -> IO Bool
doesFileExist ([FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
files)
      if Bool
exi then FilePath -> IO ()
removeFile ([FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
files) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
putStrLn FilePath
"System.Process.Sequential.seqFlsHelp1: not successful operation. " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        FilePath -> IO ()
putStrLn FilePath
herr
      else FilePath -> IO ()
putStrLn FilePath
"System.Process.Sequential.seqFlsHelp1: not successful operation. " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
putStrLn FilePath
herr
  ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
code