-- |
-- Module      :  DobutokO.Sound.IntermediateF
-- Copyright   :  (c) OleksandrZhabenko 2020, 2024
-- License     :  MIT
-- Stability   :  Experimental
-- Måintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Helps to create experimental music from a file (or its part) and a Ukrainian text. 
-- It can also generate a timbre for the notes. Uses SoX inside.


{-# OPTIONS_GHC -threaded #-}

module DobutokO.Sound.IntermediateF (
  -- * Basic functions to work with intermediate files \"result\*wav\"
  getFileRSizes
  , getFileRSizesS
  , getFileRSizesS2
  , getFileRTuples
  , listVDirectory
  , isHighQ
  , shouldBeReplaced
  , indexesFromMrk
  -- * Functions to edit the melody by editing the intermediate files \"result\*\"
  , playAndMark
  , playAMrk
  , pAnR1
  , pAnR2
  , pAnR_
  -- ** 2G generalized variants
  , playAMrk2G
  , pAnR12G
  , pAnR22G
  , pAnR_2G
  -- * Additional functions
  -- ** Get information
  , infoFromV
  , internalConv
  , ixFromRes
  , ixInterv
  , ixInterv2G
  , thisOne
  -- ** Process and Edit
  , playSeqAR
  , playSeqARV
  , playSeqARV2
  , playCollect1Dec
  , playCollectDec
  , replaceWithHQs
  , isOddAsElem
  , maxLinV
  , minLinV
  , doubleLtoV
  , filterToBnds
  -- * 2G generalized functions
  , getFileRSizes2G
  , getFileRSizesS2G
  , getFileRTuples2G
  , listVDirectory2G
  -- * 3G generalized function
  , listVDirectory3G
  -- ** Process and Edit
  , playSeqAR2G
  , playSeqARV2G
  , playSeqARV22G
  , playCollectDec2G
  , replaceWithHQs2G
  -- * SoX effects application
  , soxBasicParams
  -- ** With \"reverb\" as the first
  -- *** No file type changes
  , reverbE
  , reverbWE
  , reverb1E
  , reverbW1E
  -- *** File type changes
  , reverbE2C
  , reverbWE2C
  , reverb1E2C
  , reverb1WE2C
  -- ** Generalized
  -- *** No file type changes
  , soxE1
  , getSilenceF
  , fadeAllE
  , fadeAllEMilN
  -- *** File type changes
  , soxE2C
  , soxE12C
  -- ** Playing and recording
  , recE
  , rec1E
  , playE
  -- * 2G auxiliary functions
  , f2w
  , w2f
  , cfw2wf
  , efw2
  , efw2vv
  , wOrf
  , wavToFlac
  , flacToWav
  -- * Special SoX effects
  , soxREw1
  , soxRE1
  , soxREA1
) where

import GHC.Arr
import Numeric (showFFloat)
import CaseBi.Arr (getBFst')
import Control.Monad (void)
import Control.Concurrent (myThreadId,forkIO,threadDelay,killThread)
import qualified Data.List as L (sort)
import Control.Exception (onException)
import Sound.Control.Exception.FinalException (FinalException (NotRecorded,ExecutableNotProperlyInstalled),catchEnd)
import Data.List (isPrefixOf,isSuffixOf,(\\),maximum,minimum)
import qualified Data.Vector as V 
import System.Directory
import Sound.SoXBasics (playA, durationA)
import MMSyn7l
import EndOfExe2 (showE)
import System.Process (readProcessWithExitCode)
import Data.Maybe (fromJust,isJust)
import System.Exit (ExitCode (ExitSuccess))
import System.Info (os)

-- | Gets sizes of the \"result\*.wav\" files in the current directory. 
getFileRSizes :: IO (V.Vector Integer)
getFileRSizes :: IO (Vector Integer)
getFileRSizes = [Char] -> IO (Vector Integer)
getFileRSizes2G [Char]
"221w"

-- | Generalized variant of the 'getFileRSizes' with a possibility to get sizes either of FLAC or of WAV files. For more information, please, refer to
-- 'soxBasicParams'.
getFileRSizes2G :: String -> IO (V.Vector Integer)
getFileRSizes2G :: [Char] -> IO (Vector Integer)
getFileRSizes2G [Char]
ys = do
  dirN <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let dirN1 = [[Char]] -> Vector [Char]
forall a. [a] -> Vector a
V.fromList ([[Char]] -> Vector [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Vector [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
L.sort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
s -> [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"result" [Char]
s Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
".flac" else [Char]
".wav") [Char]
s) ([[Char]] -> Vector [Char]) -> [[Char]] -> Vector [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
dirN
  V.mapM getFileSize dirN1  

-- | Similar to 'getFileRSizes', but sizes are 'Int', not 'Integer'. For most cases it is more memory efficient.
getFileRSizesS :: IO (V.Vector Int)
getFileRSizesS :: IO (Vector Int)
getFileRSizesS = [Char] -> IO (Vector Int)
getFileRSizesS2G [Char]
"221w"

-- | Generalized variant of the 'getFileRSizesS' with a possibility to get sizes either of FLAC or of WAV files. For more information, please, refer to
-- 'soxBasicParams'.
getFileRSizesS2G :: String -> IO (V.Vector Int)
getFileRSizesS2G :: [Char] -> IO (Vector Int)
getFileRSizesS2G [Char]
ys = do
  dirN0 <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let dirN2 = [[Char]] -> Vector [Char]
forall a. [a] -> Vector a
V.fromList ([[Char]] -> Vector [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Vector [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
L.sort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
s -> [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"result" [Char]
s Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
".flac" else [Char]
".wav") [Char]
s) ([[Char]] -> Vector [Char]) -> [[Char]] -> Vector [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
dirN0
  sizes1 <- V.mapM getFileSize dirN2
  return . V.map fromIntegral $ sizes1

-- | Variant of 'getFileRSizes' function.
getFileRSizesS2 :: IO (V.Vector Int)
getFileRSizesS2 :: IO (Vector Int)
getFileRSizesS2 = IO (Vector Integer)
getFileRSizes IO (Vector Integer)
-> (Vector Integer -> IO (Vector Int)) -> IO (Vector Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Vector Integer
s -> Vector Int -> IO (Vector Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Int -> IO (Vector Int))
-> (Vector Integer -> Vector Int)
-> Vector Integer
-> IO (Vector Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Int) -> Vector Integer -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Integer -> IO (Vector Int))
-> Vector Integer -> IO (Vector Int)
forall a b. (a -> b) -> a -> b
$ Vector Integer
s

-- | Gets 'V.Vector' of tuples of the pairs of \"result\*.wav\" files and their respective sizes.
getFileRTuples :: IO (V.Vector (FilePath,Integer))
getFileRTuples :: IO (Vector ([Char], Integer))
getFileRTuples = [Char] -> IO (Vector ([Char], Integer))
getFileRTuples2G [Char]
"221w"

-- | Generalized variant of the 'getFileRTuples' with a possibility to get sizes either of FLAC or of WAV files. For more information, please, refer to
-- 'soxBasicParams'.
getFileRTuples2G :: String -> IO (V.Vector (FilePath,Integer))
getFileRTuples2G :: [Char] -> IO (Vector ([Char], Integer))
getFileRTuples2G [Char]
ys = do
  dirN <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let dirN0 = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
L.sort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
s -> [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"result" [Char]
s Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
".flac" else [Char]
".wav") [Char]
s) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
dirN
  sizes0 <- mapM getFileSize dirN0
  let tpls = [([Char], Integer)] -> Vector ([Char], Integer)
forall a. [a] -> Vector a
V.fromList ([([Char], Integer)] -> Vector ([Char], Integer))
-> ([Integer] -> [([Char], Integer)])
-> [Integer]
-> Vector ([Char], Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Integer] -> [([Char], Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
dirN0 ([Integer] -> Vector ([Char], Integer))
-> [Integer] -> Vector ([Char], Integer)
forall a b. (a -> b) -> a -> b
$ [Integer]
sizes0
  return tpls  

-- | Gets 'V.Vector' of the filenames for \"result\*.wav\" files in the current directory.
listVDirectory :: IO (V.Vector FilePath)
listVDirectory :: IO (Vector [Char])
listVDirectory = [Char] -> IO (Vector [Char])
listVDirectory2G [Char]
"221w"

-- | Generalized variant of the 'listVDirectory' with a possibility to get 'FilePath' for either FLAC or WAV files. For more information, please, refer to
-- 'soxBasicParams'.
listVDirectory2G :: String -> IO (V.Vector FilePath)
listVDirectory2G :: [Char] -> IO (Vector [Char])
listVDirectory2G [Char]
ys = do
  dir0N <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let diNN = [[Char]] -> Vector [Char]
forall a. [a] -> Vector a
V.fromList ([[Char]] -> Vector [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Vector [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
L.sort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
s -> [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"result" [Char]
s Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
".flac" else [Char]
".wav") [Char]
s) ([[Char]] -> Vector [Char]) -> [[Char]] -> Vector [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
dir0N
  return diNN  

-- | Generalized variant of the 'listVDirectory2G' with a possibility to get 'FilePath' for not only \"result\*\" files, but to specify their 
-- beginning with the second 'String' argument. For example:
-- 
-- >  listVDirectory3G ys "result" == listVDirectory2G ys
-- 
listVDirectory3G :: String -> String -> IO (V.Vector FilePath)
listVDirectory3G :: [Char] -> [Char] -> IO (Vector [Char])
listVDirectory3G [Char]
ys [Char]
zs = do
  dir0N <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let diNN = [[Char]] -> Vector [Char]
forall a. [a] -> Vector a
V.fromList ([[Char]] -> Vector [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Vector [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
L.sort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
s -> [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
zs [Char]
s Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
".flac" else [Char]
".wav") [Char]
s) ([[Char]] -> Vector [Char]) -> [[Char]] -> Vector [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
dir0N
  return diNN   

-- | During function evaluation you can listen to the sound files and mark them with \"1\" and \"0\". The first one means that the sound is considered
-- of higher quality and is intended to be used as a replacement for the worse sounds marked by \"0\". The function returns a 'V.Vector' of specially formatted
-- 'String' that represents only those files that are connected with the replacement procedure.
playAndMark :: V.Vector FilePath -> IO (V.Vector String)
playAndMark :: Vector [Char] -> IO (Vector [Char])
playAndMark Vector [Char]
vec
  | Vector [Char] -> Bool
forall a. Vector a -> Bool
V.null Vector [Char]
vec = Vector [Char] -> IO (Vector [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Vector [Char]
forall a. Vector a
V.empty
  | Bool
otherwise = (Int -> [Char] -> IO [Char]) -> Vector [Char] -> IO (Vector [Char])
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
V.imapM (\Int
i [Char]
xs -> do
      duration <- [Char] -> IO Float
durationA ([Char] -> IO Float) -> [Char] -> IO Float
forall a b. (a -> b) -> a -> b
$ Vector [Char] -> Int -> [Char]
forall a. Vector a -> Int -> a
V.unsafeIndex Vector [Char]
vec Int
i
      putStrLn "Listen to the next sound, please. Please, do not enter anything while sound plays. "
      forkIO $ do
        myThread <- myThreadId
        playA xs
        killThread myThread
      threadDelay (read (show $ truncate (duration * 1000000))::Int)
      putStr "How do you mark the file that has just been played now -- if of high quality, print \"1\", if of low quality, print \"0\", "
      putStrLn "if it is just accepted, press \'Enter\'. "  
      mark0 <- getLine
      putStrLn "-----------------------------------------------------------------------------------------"
      let mark = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
mark0
      case mark of
        [Char]
"1" -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"*" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
xs
        [Char]
"0" -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"**" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
xs
        [Char]
_   -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []) Vector [Char]
vec IO (Vector [Char])
-> (Vector [Char] -> IO (Vector [Char])) -> IO (Vector [Char])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> IO Bool) -> Vector [Char] -> IO (Vector [Char])
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM (Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> ([Char] -> Bool) -> [Char] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) 

-- | Function 'playAndMark' applied to all the \"result\*.wav\" files in the current directory.
playAMrk :: IO (V.Vector String)
playAMrk :: IO (Vector [Char])
playAMrk = [Char] -> IO (Vector [Char])
playAMrk2G [Char]
"221w"

-- | Generalized variant of the 'playAMrk' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to
-- 'soxBasicParams'.
playAMrk2G :: String -> IO (V.Vector String)
playAMrk2G :: [Char] -> IO (Vector [Char])
playAMrk2G [Char]
ys = [Char] -> IO (Vector [Char])
listVDirectory2G [Char]
ys IO (Vector [Char])
-> (Vector [Char] -> IO (Vector [Char])) -> IO (Vector [Char])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Vector [Char] -> IO (Vector [Char])
playAndMark

-- | Function-predicate to check whether a file corresponding to its 'String' argument is needed to be replaced while processing.
shouldBeReplaced :: String -> Bool
shouldBeReplaced :: [Char] -> Bool
shouldBeReplaced (Char
x:Char
y:[Char]
xs)
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' = Bool
True
  | Bool
otherwise = [Char] -> Bool
shouldBeReplaced (Char
yChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs)
shouldBeReplaced [Char]
_ = Bool
False

-- | Function-predicate to check whether a file corresponding to its 'String' argument is considered as one of higher quality and therefore can be used
-- to replace the not so suitable ones while processing.
isHighQ :: String -> Bool
isHighQ :: [Char] -> Bool
isHighQ [Char]
xs = ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> ([Char] -> [Char]) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*') ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

-- | Gets an index of the 'V.Vector' element corresponding to the 'String' generated by 'playAndMark' function.
indexesFromMrk :: String -> Int
indexesFromMrk :: [Char] -> Int
indexesFromMrk [Char]
xs = [Char] -> Int
forall a. Read a => [Char] -> a
read ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'*') [Char]
xs)::Int

-- | Used to obtain parameters for processment.
internalConv :: ([String],[String]) -> (V.Vector Int, V.Vector String)
internalConv :: ([[Char]], [[Char]]) -> (Vector Int, Vector [Char])
internalConv ([[Char]]
xss,[[Char]]
yss) = ([Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList ([Int] -> Vector Int)
-> ([[Char]] -> [Int]) -> [[Char]] -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
indexesFromMrk ([[Char]] -> Vector Int) -> [[Char]] -> Vector Int
forall a b. (a -> b) -> a -> b
$ [[Char]]
xss,[[Char]] -> Vector [Char]
forall a. [a] -> Vector a
V.fromList ([[Char]] -> Vector [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Vector [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*')) ([[Char]] -> Vector [Char]) -> [[Char]] -> Vector [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
yss)

-- | Axiliary function to get a 'String' of consequent digits in the name of the \"result\*.wav\" file.
ixFromRes :: String -> String
ixFromRes :: [Char] -> [Char]
ixFromRes [Char]
xs = ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') [Char]
xs) [Char] -> [Char] -> [Char]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Char]
"result"

-- | Given an index of the element in the 'listVDirectory' output returns a tuple of the boundaries of the indexes usable for playback. 
-- Note: index0 is probably from [0..], l1 is necessarily from [0..]. Interesting case is: 0 <= index0 < l1.
ixInterv :: Int -> IO (Int, Int)
ixInterv :: Int -> IO (Int, Int)
ixInterv = [Char] -> Int -> IO (Int, Int)
ixInterv2G [Char]
"221w"

-- | Given an index of the element in the 'listVDirectory2G' (with the same 'String' as the second argument) output returns a tuple of the
-- boundaries of the indexes usable for playback. 
-- Note: index0 is probably from [0..], l1 is necessarily from [0..]. Interesting case is: 0 <= index0 < l1.
ixInterv2G :: String -> Int -> IO (Int, Int)
ixInterv2G :: [Char] -> Int -> IO (Int, Int)
ixInterv2G [Char]
ys Int
index0
  | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
index0 Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = do
      dirV <- [Char] -> IO (Vector [Char])
listVDirectory2G [Char]
ys
      let l1 = Vector [Char] -> Int
forall a. Vector a -> Int
V.length Vector [Char]
dirV
      case compare l1 13 of
        Ordering
LT -> (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0,Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Ordering
_  -> (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0,Int
11)
  | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
index0 Int
7 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = do
      dirV <- [Char] -> IO (Vector [Char])
listVDirectory2G [Char]
ys
      let l1 = Vector [Char] -> Int
forall a. Vector a -> Int
V.length Vector [Char]
dirV
      case compare index0 (l1 - 5) of
        Ordering
GT -> (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) 
        Ordering
_  -> (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
index0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)     
  | Bool
otherwise = do
      dirV <- [Char] -> IO (Vector [Char])
listVDirectory2G [Char]
ys
      let l1 = Vector [Char] -> Int
forall a. Vector a -> Int
V.length Vector [Char]
dirV
      case compare l1 13 of
       Ordering
LT -> (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0,Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
       Ordering
_  -> 
         case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
index0 (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) of
           Ordering
GT -> (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
index0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7, Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
           Ordering
_  -> (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
index0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7, Int
index0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)           

-- | Parser to the result of 'listVDirectory2G' function to get the needed information.
infoFromV :: V.Vector String -> [(V.Vector Int, V.Vector String)]
infoFromV :: Vector [Char] -> [(Vector Int, Vector [Char])]
infoFromV Vector [Char]
vec = (Vector [Char] -> (Vector Int, Vector [Char]))
-> [Vector [Char]] -> [(Vector Int, Vector [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (([[Char]], [[Char]]) -> (Vector Int, Vector [Char])
internalConv (([[Char]], [[Char]]) -> (Vector Int, Vector [Char]))
-> (Vector [Char] -> ([[Char]], [[Char]]))
-> Vector [Char]
-> (Vector Int, Vector [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], [Char])] -> ([[Char]], [[Char]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([Char], [Char])] -> ([[Char]], [[Char]]))
-> (Vector [Char] -> [([Char], [Char])])
-> Vector [Char]
-> ([[Char]], [[Char]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ([Char], [Char]) -> [([Char], [Char])]
forall a. Vector a -> [a]
V.toList (Vector ([Char], [Char]) -> [([Char], [Char])])
-> (Vector [Char] -> Vector ([Char], [Char]))
-> Vector [Char]
-> [([Char], [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> ([Char], [Char]))
-> Vector [Char] -> Vector ([Char], [Char])
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*'))) [Vector [Char]
v1, Vector [Char]
v2]
  where (Vector [Char]
v1, Vector [Char]
v2) = ([Char] -> Bool) -> Vector [Char] -> (Vector [Char], Vector [Char])
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.partition [Char] -> Bool
shouldBeReplaced Vector [Char]
vec

-- | Plays a sequence of sounds in the interval of them obtained by 'ixInterv' function.
playSeqAR :: Int -> IO ()
playSeqAR :: Int -> IO ()
playSeqAR = [Char] -> Int -> IO ()
playSeqAR2G [Char]
"221w"

-- | Generalized variant of the 'playSeqAR' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to
-- 'soxBasicParams'.
playSeqAR2G :: String -> Int -> IO ()
playSeqAR2G :: [Char] -> Int -> IO ()
playSeqAR2G [Char]
ys Int
index0 = do
  (minBnd,maxBnd) <- [Char] -> Int -> IO (Int, Int)
ixInterv2G [Char]
ys Int
index0
  dirV2 <- listVDirectory2G ys
  mapM_ (playA . V.unsafeIndex dirV2) [minBnd..maxBnd]  

-- | Plays a sequence of consequential sounds in the melody in the interval of them obtained by 'ixInterv' function for each element index
-- from 'V.Vector' of indexes.
playSeqARV :: V.Vector Int -> IO ()
playSeqARV :: Vector Int -> IO ()
playSeqARV = [Char] -> Vector Int -> IO ()
playSeqARV2G [Char]
"221w"

-- | Generalized variant of the 'playSeqARV' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to
-- 'soxBasicParams'.
playSeqARV2G :: String -> V.Vector Int -> IO ()
playSeqARV2G :: [Char] -> Vector Int -> IO ()
playSeqARV2G [Char]
ys Vector Int
vec = do
  dirV2 <- [Char] -> IO (Vector [Char])
listVDirectory2G [Char]
ys
  V.mapM_ (playA . V.unsafeIndex dirV2) vec

-- | Plays a sequence of WAV sounds considered of higher quality.
playSeqARV2 :: V.Vector String -> IO ()
playSeqARV2 :: Vector [Char] -> IO ()
playSeqARV2 = [Char] -> Vector [Char] -> IO ()
playSeqARV22G [Char]
"221w"

-- | Plays a sequence of sounds considered of higher quality.
playSeqARV22G :: String -> V.Vector String -> IO ()
playSeqARV22G :: [Char] -> Vector [Char] -> IO ()
playSeqARV22G [Char]
ys Vector [Char]
vec = do
  let indexesHQs :: Vector Int
indexesHQs = (Vector Int, Vector [Char]) -> Vector Int
forall a b. (a, b) -> a
fst ((Vector Int, Vector [Char]) -> Vector Int)
-> (Vector [Char] -> (Vector Int, Vector [Char]))
-> Vector [Char]
-> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Vector Int, Vector [Char])] -> (Vector Int, Vector [Char])
forall a. HasCallStack => [a] -> a
last ([(Vector Int, Vector [Char])] -> (Vector Int, Vector [Char]))
-> (Vector [Char] -> [(Vector Int, Vector [Char])])
-> Vector [Char]
-> (Vector Int, Vector [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [(Vector Int, Vector [Char])]
infoFromV (Vector [Char] -> Vector Int) -> Vector [Char] -> Vector Int
forall a b. (a -> b) -> a -> b
$ Vector [Char]
vec  
  [Char] -> Vector Int -> IO ()
playSeqARV2G [Char]
ys Vector Int
indexesHQs  

-- | The same as 'playSeqARV2', but additionally collects the resulting 'Bool' values and then returns them. It is used to define, which sounds  from those of
-- higher quality will replace those ones considered to be replaced.
playCollectDec :: V.Vector String -> IO (V.Vector Bool)
playCollectDec :: Vector [Char] -> IO (Vector Bool)
playCollectDec = [Char] -> Vector [Char] -> IO (Vector Bool)
playCollectDec2G [Char]
"221w"

-- | Generalized variant of the 'playCollectDec' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to
-- 'soxBasicParams'.
playCollectDec2G :: String -> V.Vector String -> IO (V.Vector Bool)
playCollectDec2G :: [Char] -> Vector [Char] -> IO (Vector Bool)
playCollectDec2G [Char]
ys Vector [Char]
vec = do
  dirV3 <- [Char] -> IO (Vector [Char])
listVDirectory2G [Char]
ys
  let indexesHQs = (Vector Int, Vector [Char]) -> Vector Int
forall a b. (a, b) -> a
fst ((Vector Int, Vector [Char]) -> Vector Int)
-> (Vector [Char] -> (Vector Int, Vector [Char]))
-> Vector [Char]
-> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Vector Int, Vector [Char])] -> (Vector Int, Vector [Char])
forall a. HasCallStack => [a] -> a
last ([(Vector Int, Vector [Char])] -> (Vector Int, Vector [Char]))
-> (Vector [Char] -> [(Vector Int, Vector [Char])])
-> Vector [Char]
-> (Vector Int, Vector [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [(Vector Int, Vector [Char])]
infoFromV (Vector [Char] -> Vector Int) -> Vector [Char] -> Vector Int
forall a b. (a -> b) -> a -> b
$ Vector [Char]
vec
  V.mapM (playCollect1Dec dirV3) indexesHQs  

-- | Actually replaces the file represented by 'FilePath' argument with no (then there is no replacement at all), or with just one,
-- or with a sequence of sounds being considered of higher quality to form a new melody. If the lengths of the second and the third
-- arguments differs from each other then the function uses as these arguments truncated vectors of the minimal of the two lengths. 
replaceWithHQs :: FilePath -> V.Vector Bool -> V.Vector FilePath -> IO ()
replaceWithHQs :: [Char] -> Vector Bool -> Vector [Char] -> IO ()
replaceWithHQs = [Char] -> [Char] -> Vector Bool -> Vector [Char] -> IO ()
replaceWithHQs2G [Char]
"221w"

-- | Generalized variant of the 'replaceWithHQs' with a possibility to work either with FLAC files or with WAV files.
-- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. 
replaceWithHQs2G :: String -> FilePath -> V.Vector Bool -> V.Vector FilePath -> IO ()
replaceWithHQs2G :: [Char] -> [Char] -> Vector Bool -> Vector [Char] -> IO ()
replaceWithHQs2G [Char]
ys [Char]
file0 Vector Bool
vecBools Vector [Char]
stringHQs
 | Vector Bool -> Int
forall a. Vector a -> Int
V.length Vector Bool
vecBools Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector [Char] -> Int
forall a. Vector a -> Int
V.length Vector [Char]
stringHQs =
   case Vector [Char] -> Int
forall a. Vector a -> Int
V.length Vector [Char]
stringHQs of
    Int
0 -> [Char] -> IO ()
putStrLn [Char]
"That's all!"
    Int
1 | Vector Bool -> Int -> Bool
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Bool
vecBools Int
0 -> do
         [Char] -> [Char] -> IO ()
copyFile ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head ([[Char]] -> [Char])
-> (Vector [Char] -> [[Char]]) -> Vector [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
V.toList (Vector [Char] -> [Char]) -> Vector [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Vector [Char]
stringHQs) ([Char]
"resultI." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
"flac" else [Char]
"wav")
         [Char] -> [Char] -> IO ()
renameFile ([Char]
"resultI." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
"flac" else [Char]
"wav") [Char]
file0
      | Bool
otherwise -> [Char] -> IO ()
putStrLn [Char]
"Nothing has changed. "
    Int
_ -> do
         let yss :: [[Char]]
yss = Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
V.toList (Vector [Char] -> [[Char]])
-> (Vector [Char] -> Vector [Char]) -> Vector [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Char] -> Bool) -> Vector [Char] -> Vector [Char]
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i [Char]
_ -> Vector Bool -> Int -> Bool
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Bool
vecBools Int
i) (Vector [Char] -> [[Char]]) -> Vector [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Vector [Char]
stringHQs
         case [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
yss of
          Int
0 -> [Char] -> IO ()
putStrLn [Char]
"That's all!"
          Int
1 -> [Char] -> [Char] -> IO ()
copyFile ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
yss) [Char]
file0
          Int
_ -> do
            (_,_,herr) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]]
yss [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys [[Char]
"",[Char]
file0]) [Char]
""
            putStrLn herr
 | Bool
otherwise =
  let stringHQ2s :: Vector [Char]
stringHQ2s = Int -> Vector [Char] -> Vector [Char]
forall a. Int -> Vector a -> Vector a
V.take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Vector Bool -> Int
forall a. Vector a -> Int
V.length Vector Bool
vecBools) (Vector [Char] -> Int
forall a. Vector a -> Int
V.length Vector [Char]
stringHQs)) Vector [Char]
stringHQs
      vecBool2s :: Vector Bool
vecBool2s  = Int -> Vector Bool -> Vector Bool
forall a. Int -> Vector a -> Vector a
V.take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Vector Bool -> Int
forall a. Vector a -> Int
V.length Vector Bool
vecBools) (Vector [Char] -> Int
forall a. Vector a -> Int
V.length Vector [Char]
stringHQs)) Vector Bool
vecBools in [Char] -> [Char] -> Vector Bool -> Vector [Char] -> IO ()
replaceWithHQs2G [Char]
ys [Char]
file0 Vector Bool
vecBool2s Vector [Char]
stringHQ2s

-- | 'IO' checkbox whether to add the sound played to the sequence of sounds that will replace the needed one.
thisOne :: IO Bool
thisOne :: IO Bool
thisOne = do
  [Char] -> IO ()
putStrLn [Char]
"Would you like to add this sound played just now to the sequence of sounds that will replace the needed one? "
  yes <- IO [Char]
getLine
  putStrLn "-----------------------------------------------------------------------"
  return $ take 1 yes == "1"

-- | Plays a sound file considered to be of higher quality and then you define whether to use the played sound to replace that one considered to be replaced.
playCollect1Dec :: V.Vector String -> Int -> IO Bool
playCollect1Dec :: Vector [Char] -> Int -> IO Bool
playCollect1Dec Vector [Char]
dirV2 Int
i 
  | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i (Vector [Char] -> Int
forall a. Vector a -> Int
V.length Vector [Char]
dirV2) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = do 
     [Char] -> IO ()
playA ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector [Char] -> Int -> [Char]
forall a. Vector a -> Int -> a
V.unsafeIndex Vector [Char]
dirV2 Int
i
     IO Bool
thisOne
  | Bool
otherwise = [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"DobutokO.Sound.IntermediateF.playCollect1Dec: wrong Int parameter! "

-- | Process the sound corresponding to the first element in the first argument. Returns a 'V.tail' of the first element of the first command line argument.
-- Replaces (if specified) the sound with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality.
pAnR1 :: V.Vector String -> IO (V.Vector String)
pAnR1 :: Vector [Char] -> IO (Vector [Char])
pAnR1 = [Char] -> Vector [Char] -> IO (Vector [Char])
pAnR12G [Char]
"221w"

-- | Generalized variant of the 'pAnR1' with a possibility to work either with FLAC files or with WAV files.
-- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. 
pAnR12G :: String -> V.Vector String -> IO (V.Vector String)
pAnR12G :: [Char] -> Vector [Char] -> IO (Vector [Char])
pAnR12G [Char]
ys Vector [Char]
vec
 | Vector [Char] -> Bool
forall a. Vector a -> Bool
V.null Vector [Char]
vec = [Char] -> IO ()
putStrLn [Char]
"You have processed all the marked files! " IO () -> IO (Vector [Char]) -> IO (Vector [Char])
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Vector [Char] -> IO (Vector [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Vector [Char]
forall a. Vector a
V.empty
 | Bool
otherwise = do
    let [(Vector Int
indexes0,Vector [Char]
strings),(Vector Int
indexesHQ,Vector [Char]
stringHQs)] = Vector [Char] -> [(Vector Int, Vector [Char])]
infoFromV Vector [Char]
vec
    [Char] -> IO ()
putStrLn [Char]
"Please, listen to the melody and remember what sound you would like to replace and the surrounding sounds. "
    [Char] -> Int -> IO ()
playSeqAR2G [Char]
ys (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
indexes0 Int
0
    [Char] -> IO ()
putStrLn [Char]
"---------------------------------------------------------------"
    [Char] -> IO ()
putStrLn [Char]
"Now, please, listen to a collection of sounds considered of higher quality which you can use to replace the needed one. "
    vecBools <- [Char] -> Vector [Char] -> IO (Vector Bool)
playCollectDec2G [Char]
ys Vector [Char]
vec
    replaceWithHQs2G ys (V.unsafeIndex strings 0) vecBools stringHQs
    return $ V.map (\(Int
ix,[Char]
xs) -> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"**" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
xs) . V.zip (V.unsafeDrop 1 indexes0) $ (V.unsafeDrop 1 strings)

-- | Process the WAV sounds consequently corresponding to the elements in the first argument.
-- Replaces (if specified) the sounds with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality for every sound needed.
pAnR2 :: V.Vector String -> IO ()
pAnR2 :: Vector [Char] -> IO ()
pAnR2 = [Char] -> Vector [Char] -> IO ()
pAnR22G [Char]
"221w"

-- | Generalized variant of the 'pAnR2' with a possibility to work either with FLAC files or with WAV files.
-- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. 
pAnR22G :: String -> V.Vector String -> IO ()
pAnR22G :: [Char] -> Vector [Char] -> IO ()
pAnR22G [Char]
ys Vector [Char]
vec
 | Vector [Char] -> Bool
forall a. Vector a -> Bool
V.null Vector [Char]
vec = [Char] -> IO ()
putStrLn [Char]
"You have processed all the marked files! "
 | Bool
otherwise = IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException ([Char] -> Vector [Char] -> IO (Vector [Char])
pAnR12G [Char]
ys Vector [Char]
vec IO (Vector [Char]) -> (Vector [Char] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Vector [Char] -> IO ()
pAnR22G [Char]
ys) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Marks the needed WAV files as of needed to be replaced or those ones considered of higher quality that will replace the needed ones. Then actually replaces them
-- as specified. Uses internally 'playAMrk' and 'pAnR2' functions. 
pAnR_ :: IO ()
pAnR_ :: IO ()
pAnR_ = [Char] -> IO ()
pAnR_2G [Char]
"221w"

-- | Generalized variant of the 'pAnR_' with a possibility to work either with FLAC files or with WAV files.
-- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. 
pAnR_2G :: String -> IO ()
pAnR_2G :: [Char] -> IO ()
pAnR_2G [Char]
ys = do
  vec <- [Char] -> IO (Vector [Char])
playAMrk2G [Char]
ys
  pAnR22G ys vec


----------------------------------------------------------------------------------------------------------------

-- | Takes a filename to be applied a SoX \"reverb" effect with parameters of list of 'String' (the second argument). Produces the temporary
-- new file with the name ((name-of-the-file) ++ (\"reverb.wav\" OR \"reverb.flac\") -- the type is preserved), which then is removed.
-- Please, remember that for the mono audio the after applied function file is stereo with 2 channels.
--
-- Besides, you can specify other SoX effects after reverberation in a list of 'String'. The syntaxis is that every separate literal must be
-- a new element in the list. If you plan to create again mono audio in the end of processment, then probably use 'reverb1E' funcion instead. 
-- If you would like to use instead of \"reverb\" its modification \"reverb -w\" effect (refer to SoX documentation), then probably it is more
-- convenient to use 'reverbWE' function. Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified
-- file and to the containing it directory. The function is not intended to be used in otherwise cases.
reverbE :: FilePath -> [String] -> IO ()
reverbE :: [Char] -> [[Char]] -> IO ()
reverbE [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file,[Char]
"reverb"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs) [Char]
""
  case code of
    ExitCode
ExitSuccess -> [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file) [Char]
file
    ExitCode
_ -> do
       [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file
       [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.reverbE \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. "

-- | Similar to 'reverbE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another
-- extension and type.
reverbE2C :: FilePath -> [String] -> IO ()
reverbE2C :: [Char] -> [[Char]] -> IO ()
reverbE2C [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file,[Char]
"reverb"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs) [Char]
""
  case code of
    ExitCode
ExitSuccess -> do { [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file) ([Char] -> [Char]
cfw2wf [Char]
file) ; [Char] -> IO ()
removeFile [Char]
file }
    ExitCode
_           -> do { [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file
                      ; [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.reverbE2C \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. " }

-- | The same as 'reverbE', but at the end file is being mixed to obtain mono audio. The name of the temporary file is ((name-of-the-file) ++
--  (\"reverb1.wav\" OR \"reverb1.flac\") -- the type is preserved).
-- Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified
-- file and to the containing it directory. The function is not intended to be used in otherwise cases.
reverb1E :: FilePath -> [String] -> IO ()
reverb1E :: [Char] -> [[Char]] -> IO ()
reverb1E [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file,[Char]
"reverb"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"channels",[Char]
"1"]) [Char]
""
  case code of
    ExitCode
ExitSuccess -> [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file) [Char]
file
    ExitCode
_ -> do
       [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file
       [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.reverb1E \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. "

-- | Similar to 'reverb1E', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another
-- extension and type.
reverb1E2C :: FilePath -> [String] -> IO ()
reverb1E2C :: [Char] -> [[Char]] -> IO ()
reverb1E2C [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file,[Char]
"reverb"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"channels",[Char]
"1"]) [Char]
""
  case code of
    ExitCode
ExitSuccess -> do { [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file) ([Char] -> [Char]
cfw2wf [Char]
file) ; [Char] -> IO ()
removeFile [Char]
file }
    ExitCode
_ -> do
       [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverb1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file
       [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.reverb1E2C \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. "       

-- | The same as 'reverbE', but uses \"reverb -w\" effect instead of \"reverb\". The name of the temporary file is
-- ((name-of-the-file) ++ (\"reverbW.wav\" OR \"reverbW.flac\") -- the type is preserved). Please, for more information, refer to SoX documentation.
-- Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified
-- file and to the containing it directory. The function is not intended to be used in otherwise cases.
reverbWE :: FilePath -> [String] -> IO ()
reverbWE :: [Char] -> [[Char]] -> IO ()
reverbWE [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file,[Char]
"reverb",[Char]
"-w"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs) [Char]
""
  case code of
    ExitCode
ExitSuccess -> [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file) [Char]
file
    ExitCode
_ -> do
       [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file
       [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.reverbWE \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. "

-- | Similar to 'reverbWE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another
-- extension and type.
reverbWE2C :: FilePath -> [String] -> IO ()
reverbWE2C :: [Char] -> [[Char]] -> IO ()
reverbWE2C [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file,[Char]
"reverb",[Char]
"-w"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs) [Char]
""
  case code of
    ExitCode
ExitSuccess -> do { [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file) ([Char] -> [Char]
cfw2wf [Char]
file) ; [Char] -> IO ()
removeFile [Char]
file }
    ExitCode
_           -> do { [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file
                      ; [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.reverbWE2C \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. " }

-- | The same as 'reverbWE', but at the end file is being mixed to obtain mono audio. The name of the temporary file is ((name-of-the-file)
-- ++ (\"reverbW1.wav\" OR \"reverbW1.flac\") -- the type is preserved). Please, check by yourself whether you have enough permissions
-- to read and write to the 'FilePath'-specified file and to the containing it directory. The function is not intended to be used in otherwise cases.
reverbW1E :: FilePath -> [String] -> IO ()
reverbW1E :: [Char] -> [[Char]] -> IO ()
reverbW1E [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file,[Char]
"reverb",[Char]
"-w"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"channels",[Char]
"1"]) [Char]
""
  case code of
    ExitCode
ExitSuccess -> [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file) [Char]
file
    ExitCode
_ -> do
       [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file
       [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.reverbW1E \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. "

-- | Similar to 'reverb1WE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another
-- extension and type.
reverb1WE2C :: FilePath -> [String] -> IO ()
reverb1WE2C :: [Char] -> [[Char]] -> IO ()
reverb1WE2C [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file,[Char]
"reverb",[Char]
"-w"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"channels",[Char]
"1"]) [Char]
""
  case code of
    ExitCode
ExitSuccess -> do { [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file) ([Char] -> [Char]
cfw2wf [Char]
file) ; [Char] -> IO ()
removeFile [Char]
file }
    ExitCode
_ -> do
       [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"reverbW1" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file
       [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.reverb1WE2C \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. "       

-- | Is used internally in the functions to specify different SoX parameters for the sound synthesis (rate, bit depth and file extension). Possible
-- file extensions are: ".wav" (a default one) and ".flac" (being lossless compressed); rates -- 8000, 11025, 16000, 22050 (a default one), 32000,
--  44100, 48000, 88200, 96000, 176400, 192000 Hz; bit depths -- 16 bits and 24 bits. The first two digits in a 'String' argument encodes rate,
-- the next one -- bit depth and the last symbol -- letter \'w\' or \'f\' -- file extension. Because of SoX uses FLAC optionally, before use it, please,
-- check whether your installation supports it.
soxBasicParams :: String -> [String] -> [String]
soxBasicParams :: [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys [[Char]]
xss 
 | [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
xss = []
 | Bool
otherwise =
    let ([Char]
ts,[Char]
zs) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 ([Char] -> ([Char], [Char]))
-> ([Char] -> [Char]) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
ys in (([Char], Array Int ([Char], [Char])) -> [Char] -> [Char]
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' ([Char]
"-r22050",(Int, Int) -> [([Char], [Char])] -> Array Int ([Char], [Char])
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
8) ([([Char], [Char])] -> Array Int ([Char], [Char]))
-> ([[Char]] -> [([Char], [Char])])
-> [[Char]]
-> Array Int ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]] -> [([Char], [Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]
"11",[Char]
"16", [Char]
"17", [Char]
"19", [Char]
"32", [Char]
"44", [Char]
"48", [Char]
"80", [Char]
"96"] ([[Char]] -> Array Int ([Char], [Char]))
-> [[Char]] -> Array Int ([Char], [Char])
forall a b. (a -> b) -> a -> b
$
      [[Char]
"-r11025",[Char]
"-r16000",[Char]
"-r176400",[Char]
"-r192000",[Char]
"-r32000",[Char]
"-r44100",[Char]
"-r48000",[Char]
"-r8000",[Char]
"-r96000"]) [Char]
ts) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (if [Char]
zs [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"2" then [Char]
"-b24" else [Char]
"-b16") [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
        ((if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
xs -> if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) [Char]
xs [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".wav" then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) [Char]
xs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".flac" else [Char]
xs) else [[Char]] -> [[Char]]
forall a. a -> a
id) ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
tail ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
xss)

-- | Similar to 'soxE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another
-- extension and type.
soxE2C :: FilePath -> [String] -> IO ()
soxE2C :: [Char] -> [[Char]] -> IO ()
soxE2C [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"effects" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs) [Char]
""
  case code of
    ExitCode
ExitSuccess -> do { [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"effects" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file) ([Char] -> [Char]
cfw2wf [Char]
file) ; [Char] -> IO ()
removeFile [Char]
file }
    ExitCode
_ -> do
       [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"effects" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file
       [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.soxE2C \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. "       

-- | The same as 'soxE', but at the end file is being mixed to obtain mono audio.
-- Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified
-- file and to the containing it directory. The function is not intended to be used in otherwise cases.
soxE1 :: FilePath -> [String] -> IO ()
soxE1 :: [Char] -> [[Char]] -> IO ()
soxE1 [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"effects" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"channels",[Char]
"1"]) [Char]
""
  case code of
    ExitCode
ExitSuccess -> [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"effects" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file) [Char]
file
    ExitCode
_ -> do
       [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"effects" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2 [Char]
file
       [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.soxE1 \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. "

-- | Similar to 'soxE1', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another
-- extension and type.
soxE12C :: FilePath -> [String] -> IO ()
soxE12C :: [Char] -> [[Char]] -> IO ()
soxE12C [Char]
file [[Char]]
arggs = do
  (code,_,_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file,[Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"effects" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"channels",[Char]
"1"]) [Char]
""
  case code of
    ExitCode
ExitSuccess -> do { [Char] -> [Char] -> IO ()
renameFile ([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"effects" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file) ([Char] -> [Char]
cfw2wf [Char]
file) ; [Char] -> IO ()
removeFile [Char]
file }
    ExitCode
_ -> do
       [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"effects" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
efw2vv [Char]
file
       [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"DobutokO.Sound.IntermediateF.soxE12C \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" has not been successful. The file has not been changed at all. "

-- | Function takes a 'FilePath' for the new recorded file (if it already exists then it is overwritten) and a list of 'String'. The last one is
-- sent to SoX rec or something equivalent as its arguments after the filename. If you plan just afterwards to produce mono audio, it's simpler to use
-- 'rec1E' function instead. Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified
-- file and to the containing it directory. The function is not intended to be used in otherwise cases.
-- Function is adopted and changed 'Sound.SoXBasics.recA' function.
recE :: FilePath -> [String] -> IO ()
recE :: [Char] -> [[Char]] -> IO ()
recE [Char]
file [[Char]]
arggs | Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") Bool -> Bool -> Bool
&& Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
5 [Char]
os [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"mingw" = do 
  (code, _, _) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
"-t",[Char]
"waveaudio",[Char]
"-d", [Char]
file] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs)[Char]
""
  if code /= ExitSuccess
    then do
      e0 <- doesFileExist file
      if e0
        then do
          removeFile file
          catchEnd (NotRecorded file)
        else catchEnd (NotRecorded file)
    else do
      e1 <- doesFileExist file
      if e1
        then return ()
        else catchEnd (NotRecorded file)
                 | Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"rec") = do
  (code, _, _) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"rec")) ([Char]
file[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
arggs) [Char]
""
  if code /= ExitSuccess
    then do
      e0 <- doesFileExist file
      if e0
        then do
          removeFile file
          catchEnd (NotRecorded file)
        else catchEnd (NotRecorded file)
    else do
      e1 <- doesFileExist file
      if e1
        then return ()
        else catchEnd (NotRecorded file)
                 | Bool
otherwise = FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Function takes a 'FilePath' for the new recorded file (if it already exists then it is overwritten) and a list of 'String'. The last one is
-- sent to SoX rec or something equivalent as its arguments after the filename. Please, check by yourself whether you have enough permissions
-- to read and write to the 'FilePath'-specified file and to the containing it directory. The function is not intended to be used in otherwise cases.
-- Function is adopted and changed 'Sound.SoXBasics.recA' function.
rec1E :: FilePath -> [String] -> IO ()
rec1E :: [Char] -> [[Char]] -> IO ()
rec1E [Char]
file [[Char]]
arggs | Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") Bool -> Bool -> Bool
&& Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
5 [Char]
os [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"mingw" = do 
  (code, _, _) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
"-t",[Char]
"waveaudio",[Char]
"-d", [Char]
file] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"channels",[Char]
"1"])[Char]
""
  if code /= ExitSuccess
    then do
      e0 <- doesFileExist file
      if e0
        then do
          removeFile file
          catchEnd (NotRecorded file)
        else catchEnd (NotRecorded file)
    else do
      e1 <- doesFileExist file
      if e1
        then return ()
        else catchEnd (NotRecorded file)
                 | Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"rec") = do
  (code, _, _) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"rec")) ([[Char]
file] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"channels",[Char]
"1"]) [Char]
""
  if code /= ExitSuccess
    then do
      e0 <- doesFileExist file
      if e0
        then do
          removeFile file
          catchEnd (NotRecorded file)
        else catchEnd (NotRecorded file)
    else do
      e1 <- doesFileExist file
      if e1
        then return ()
        else catchEnd (NotRecorded file)
                 | Bool
otherwise = FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Plays a 'FilePath' file with a SoX further effects specified by the list of 'String'. It can be e. g. used to (safely) test the result of applying
-- some SoX effects and only then to use 'soxE' or some similar functions to actually apply them.
-- Please, check by yourself whether you have enough permissions to read the 'FilePath'-specified
-- file and the containing it directory. The function is not intended to be used in otherwise cases.
-- Function is adopted and changed 'Sound.SoXBasics.playA' function.
playE :: FilePath -> [String] -> IO ()
playE :: [Char] -> [[Char]] -> IO ()
playE [Char]
file [[Char]]
arggs | Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
5 [Char]
os [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"mingw" = 
  if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"sox") 
    then IO (ExitCode, [Char], [Char]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([[Char]
file, [Char]
"-t", [Char]
"waveaudio", [Char]
"-d"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs) [Char]
"")
    else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
                 | Bool
otherwise = if Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust ([Char] -> Maybe [Char]
showE [Char]
"play") 
  then IO (ExitCode, [Char], [Char]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"play")) ([[Char]
file] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
arggs) [Char]
"")
  else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled

-- | Changes the volume of the given 'FilePath' with supported by SoX sound file type so that it becomes 0 (zero). Makes so it a silence file with the
-- same parameters for duration, rate, bit depth and file type.
getSilenceF :: FilePath -> IO ()
getSilenceF :: [Char] -> IO ()
getSilenceF [Char]
file = [Char] -> [[Char]] -> IO ()
soxE [Char]
file [[Char]
"vol",[Char]
"0"]

-- | Applies 'fadeEnds' to all the \"zs*.wav\" (or instead all the \"zs*.flac\") files in the current directory. The file extension
-- is defined by the first 'String' argument in accordance with 'soxBasicParams'. @zs@ here is given by the second 'String' argument.
fadeAllE :: String -> String -> IO ()
fadeAllE :: [Char] -> [Char] -> IO ()
fadeAllE [Char]
ys [Char]
zs = [Char] -> [Char] -> IO (Vector [Char])
listVDirectory3G [Char]
ys [Char]
zs IO (Vector [Char]) -> (Vector [Char] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> IO ()) -> Vector [Char] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ [Char] -> IO ()
fadeEnds

-- | Applies 'fadeEndsMilN' to all the \"zs*.wav\" (or instead all the \"zs*.flac\") files in the current directory. The file extension
-- is defined by the first 'String' argument in accordance with 'soxBasicParams'. @zs@ here is given by the second 'String' argument. The 'Int' argument 
-- defines a number of miliseconds to be under fading effect (no more than 10).
fadeAllEMilN :: Int -> String -> String -> IO ()
fadeAllEMilN :: Int -> [Char] -> [Char] -> IO ()
fadeAllEMilN Int
n [Char]
ys [Char]
zs = [Char] -> [Char] -> IO (Vector [Char])
listVDirectory3G [Char]
ys [Char]
zs IO (Vector [Char]) -> (Vector [Char] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> IO ()) -> Vector [Char] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (Int -> [Char] -> IO ()
fadeEndsMilN Int
n) 

-------------------------------------------------------------------------------------------  

-- | A predicate to decide whether an element @a@ belongs to the odd number of the lists of @a@ in the 'V.Vector'. 
isOddAsElem :: Eq a => a -> V.Vector [a] -> Bool
isOddAsElem :: forall a. Eq a => a -> Vector [a] -> Bool
isOddAsElem a
x Vector [a]
v
  | Vector [a] -> Bool
forall a. Vector a -> Bool
V.null Vector [a]
v = Bool
False
  | Bool
otherwise = (Vector Int -> Int
forall a. Vector a -> Int
V.length (Vector Int -> Int)
-> (Vector [a] -> Vector Int) -> Vector [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> Vector [a] -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector Int
V.findIndices (a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x) (Vector [a] -> Int) -> Vector [a] -> Int
forall a b. (a -> b) -> a -> b
$ Vector [a]
v) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

-- | All @[a]@ must be finite. To obtain @Just a0@ as a result, at least one of the @[a]@ must be not empty and 'V.Vector' must have finite length.
-- If 'V.Vector' is 'V.empty' or all @[a]@ are null (the vector has finite length), then the result is 'Nothing'. Otherwise, it will run infinitely
-- just until it runs over the available memory.
maxLinV :: Ord a => V.Vector [a] -> Maybe a
maxLinV :: forall a. Ord a => Vector [a] -> Maybe a
maxLinV Vector [a]
v
  | ([a] -> Bool) -> Vector [a] -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector [a]
v  Bool -> Bool -> Bool
|| Vector [a] -> Bool
forall a. Vector a -> Bool
V.null Vector [a]
v = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (Vector a -> a
forall a. Ord a => Vector a -> a
V.maximum (Vector a -> a) -> (Vector [a] -> Vector a) -> Vector [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a) -> Vector [a] -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Vector [a] -> Vector a)
-> (Vector [a] -> Vector [a]) -> Vector [a] -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> Vector [a] -> Vector [a]
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Vector [a] -> a) -> Vector [a] -> a
forall a b. (a -> b) -> a -> b
$ Vector [a]
v)

-- | All @[a]@ must be finite. To obtain @Just a0@ as a result, at least one of the @[a]@ must be not empty and 'V.Vector' must have finite length.
-- If 'V.Vector' is 'V.empty' or all @[a]@ are null (the vector has finite length), then the result is 'Nothing'. Otherwise, it will run infinitely
-- just until it runs over the available memory.
minLinV :: Ord a => V.Vector [a] -> Maybe a
minLinV :: forall a. Ord a => Vector [a] -> Maybe a
minLinV Vector [a]
v
  | ([a] -> Bool) -> Vector [a] -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector [a]
v Bool -> Bool -> Bool
|| Vector [a] -> Bool
forall a. Vector a -> Bool
V.null Vector [a]
v = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (Vector a -> a
forall a. Ord a => Vector a -> a
V.minimum (Vector a -> a) -> (Vector [a] -> Vector a) -> Vector [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a) -> Vector [a] -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Vector [a] -> Vector a)
-> (Vector [a] -> Vector [a]) -> Vector [a] -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> Vector [a] -> Vector [a]
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Vector [a] -> a) -> Vector [a] -> a
forall a b. (a -> b) -> a -> b
$ Vector [a]
v)

-- | Applied to list of @[a]@ where a is an instance for 'Ord' class gives a sorted in the ascending order 'V.Vector' of @a@, each of them being unique.
doubleLtoV :: Ord a => [[a]] -> V.Vector a
doubleLtoV :: forall a. Ord a => [[a]] -> Vector a
doubleLtoV = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> ([[a]] -> [a]) -> [[a]] -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall {a}. Eq a => [a] -> [a]
shortenL ([a] -> [a]) -> ([[a]] -> [a]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort ([a] -> [a]) -> ([[a]] -> [a]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
   where shortenL :: [a] -> [a]
shortenL z1 :: [a]
z1@(a
z:[a]
_)
          | [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z) [a]
z1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
shortenL ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z) [a]
z1)
          | Bool
otherwise = [a] -> [a]
shortenL ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z) [a]
z1)
         shortenL [a]
_ = []

-- | Filters 'Int' elements in a list so that they are limited with the first two 'Int' arguments of the function as a lower and a higher bounds.
filterToBnds :: Int -> Int -> [Int] -> [Int]
filterToBnds :: Int -> Int -> [Int] -> [Int]
filterToBnds Int
lbnd Int
hbnd = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
x -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
lbnd Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
hbnd Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT)

-- | Applies a special chain of the SoX effects to a file to obtain a somewhat similar to some instruments sound for some values of the 'Int' parameters. 
-- These last ones are used (after some normalizing transformation) as the arguments for the SoX \"reverb -w\" effect. For more information about their 
-- meaning, please, refer to the SoX and reverberation documentation, besides you can give them a try. 
soxREw1 :: Int -> Int -> Int -> Int -> Int -> Int -> FilePath -> IO ()
soxREw1 :: Int -> Int -> Int -> Int -> Int -> Int -> [Char] -> IO ()
soxREw1 Int
reverberance Int
damping Int
roomscale Int
stereodepth Int
predelay Int
wetgain [Char]
file = do 
  durat <- [Char] -> IO Float
durationA [Char]
file
  soxE file (concat [["channels", "2", "rate", "44100", "reverb", "-w"], map (\Int
n -> Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int
forall a. Num a => a -> a
abs Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
101)) [reverberance, damping, roomscale, stereodepth], 
    [show (abs predelay `rem` 501), show (abs wetgain `rem` 7), "trim", "0", showFFloat (Just 5) durat "", "reverse", "fade", "q", "0.002", "-0.0", "earwax"]])

-- | Applies a special chain of the SoX effects to a file to obtain a somewhat other its sounding. Similar to 'soxREw1' in realization, but can give 
-- rather another sounding. 
soxRE1 :: Int -> Int -> Int -> Int -> Int -> Int -> FilePath -> IO ()
soxRE1 :: Int -> Int -> Int -> Int -> Int -> Int -> [Char] -> IO ()
soxRE1 Int
reverberance Int
damping Int
roomscale Int
stereodepth Int
predelay Int
wetgain [Char]
file = do 
  durat <- [Char] -> IO Float
durationA [Char]
file
  soxE file (concat [["channels", "2", "rate", "44100", "reverb"], map (\Int
n -> Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int
forall a. Num a => a -> a
abs Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
101)) [reverberance, damping, roomscale, stereodepth],  
    [show (abs predelay `rem` 501), show (abs wetgain `rem` 7), "trim", "0", showFFloat (Just 5) durat "", "reverse", "fade", "q", "0.002", "-0.0", "earwax"]])

-- | Applies a special chain of the SoX effects to the files which are obtained as a result of the 'listVDirectory3G' in the current directory. 
-- For some values of the first six 'Int' parameters you obtain somewhat similar to some instruments sounds. 
-- These parameters are used (after some normalizing transformation) as the arguments for the SoX \"reverb -w\" effect. For more information about their 
-- meaning, please, refer to the SoX and reverberation documentation, besides you can give them a try. The last 'Int' parameter is the first argument 
-- for the afterwards general SoX "reverb" effect. 'String' arguments are that ones for the 'listVDirectory3G'. The 'FilePath' argument is a name 
-- for the resulting file (in the supported by the SoX format). 
soxREA1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> String -> String -> FilePath -> IO ()
soxREA1 :: Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> [Char]
-> [Char]
-> [Char]
-> IO ()
soxREA1 Int
reverberance Int
damping Int
roomscale Int
stereodepth Int
predelay Int
wetgain Int
reverb2 [Char]
ys [Char]
zs [Char]
file = do 
  dir0V <- [Char] -> [Char] -> IO (Vector [Char])
listVDirectory3G [Char]
ys [Char]
zs
  V.mapM_ (soxREw1 reverberance damping roomscale stereodepth predelay wetgain) dir0V
  (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (concat [V.toList dir0V, [file, "reverb", show (abs reverb2 `rem` 101)]]) ""
  print herr