-- |
-- Module      :  Composition.Sound.IntermediateF
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@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 Composition.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
  , soxREAS1
) where

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

-- | Gets sizes of the \"result\*.wav\" files in the current directory. 
getFileRSizes :: IO (Array Int Integer)
getFileRSizes :: IO (Array Int Integer)
getFileRSizes = String -> IO (Array Int Integer)
getFileRSizes2G String
"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 (Array Int Integer)
getFileRSizes2G :: String -> IO (Array Int Integer)
getFileRSizes2G String
ys = do
  [String]
dirN <- String -> IO [String]
listDirectory String
"."
  let dirN1 :: [String]
dirN1 = [String] -> [String]
forall a. Ord a => [a] -> [a]
L.sort ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"result" String
s Bool -> Bool -> Bool
&& String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
".flac" else String
".wav") String
s) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
dirN
  [Integer]
dir2 <- (String -> IO Integer) -> [String] -> IO [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Integer
getFileSize [String]
dirN1
  let l :: Int
l = [Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
dir2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  Array Int Integer -> IO (Array Int Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int) -> [Integer] -> Array Int Integer
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) [Integer]
dir2)

-- | Similar to 'getFileRSizes', but sizes are 'Int', not 'Integer'. For most cases it is more memory efficient.
getFileRSizesS :: IO (Array Int Int)
getFileRSizesS :: IO (Array Int Int)
getFileRSizesS = String -> IO (Array Int Int)
getFileRSizesS2G String
"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 (Array Int Int)
getFileRSizesS2G :: String -> IO (Array Int Int)
getFileRSizesS2G String
ys = do
  [String]
dirN0 <- String -> IO [String]
listDirectory String
"."
  let dirN2 :: [String]
dirN2 = [String] -> [String]
forall a. Ord a => [a] -> [a]
L.sort ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"result" String
s Bool -> Bool -> Bool
&& String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
".flac" else String
".wav") String
s) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
dirN0
      l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dirN2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  [Integer]
sizes1 <- (String -> IO Integer) -> [String] -> IO [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Integer
getFileSize [String]
dirN2
  Array Int Int -> IO (Array Int Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array Int Int -> IO (Array Int Int))
-> ([Integer] -> Array Int Int) -> [Integer] -> IO (Array Int Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Int) -> Array Int Integer -> Array Int Int
forall a b i. (a -> b) -> Array i a -> Array i b
amap Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Array Int Integer -> Array Int Int)
-> ([Integer] -> Array Int Integer) -> [Integer] -> Array Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [Integer] -> Array Int Integer
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) ([Integer] -> IO (Array Int Int))
-> [Integer] -> IO (Array Int Int)
forall a b. (a -> b) -> a -> b
$ [Integer]
sizes1

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

-- | Gets 'Array Int' of tuples of the pairs of \"result\*.wav\" files and their respective sizes.
getFileRTuples :: IO (Array Int (FilePath,Integer))
getFileRTuples :: IO (Array Int (String, Integer))
getFileRTuples = String -> IO (Array Int (String, Integer))
getFileRTuples2G String
"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 (Array Int (FilePath,Integer))
getFileRTuples2G :: String -> IO (Array Int (String, Integer))
getFileRTuples2G String
ys = do
  [String]
dirN <- String -> IO [String]
listDirectory String
"."
  let dirN0 :: [String]
dirN0 = [String] -> [String]
forall a. Ord a => [a] -> [a]
L.sort ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"result" String
s Bool -> Bool -> Bool
&& String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
".flac" else String
".wav") String
s) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
dirN
      l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dirN0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  [Integer]
sizes0 <- (String -> IO Integer) -> [String] -> IO [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Integer
getFileSize [String]
dirN0
  Array Int (String, Integer) -> IO (Array Int (String, Integer))
forall (m :: * -> *) a. Monad m => a -> m a
return (Array Int (String, Integer) -> IO (Array Int (String, Integer)))
-> ([Integer] -> Array Int (String, Integer))
-> [Integer]
-> IO (Array Int (String, Integer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [(String, Integer)] -> Array Int (String, Integer)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) ([(String, Integer)] -> Array Int (String, Integer))
-> ([Integer] -> [(String, Integer)])
-> [Integer]
-> Array Int (String, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Integer] -> [(String, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
dirN0 ([Integer] -> IO (Array Int (String, Integer)))
-> [Integer] -> IO (Array Int (String, Integer))
forall a b. (a -> b) -> a -> b
$ [Integer]
sizes0
  
-- | Gets 'Array' 'Int' of the filenames for \"result\*.wav\" files in the current directory.
listVDirectory :: IO [FilePath]
listVDirectory :: IO [String]
listVDirectory = String -> IO [String]
listVDirectory2G String
"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 [FilePath]
listVDirectory2G :: String -> IO [String]
listVDirectory2G String
ys = do
  [String]
dir0N <- String -> IO [String]
listDirectory String
"."
  let diNN :: [String]
diNN = [String] -> [String]
forall a. Ord a => [a] -> [a]
L.sort ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"result" String
s Bool -> Bool -> Bool
&& String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
".flac" else String
".wav") String
s) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
dir0N
  [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
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:
-- 
-- >  elems . listVDirectory3G ys $ "result" == listVDirectory2G ys
-- 
listVDirectory3G :: String -> String -> IO (Array Int FilePath)
listVDirectory3G :: String -> String -> IO (Array Int String)
listVDirectory3G String
ys String
zs = do
  [String]
dir0N <- String -> IO [String]
listDirectory String
"."
  let diNN :: [String]
diNN = [String] -> [String]
forall a. Ord a => [a] -> [a]
L.sort ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
zs String
s Bool -> Bool -> Bool
&& String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (if Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
".flac" else String
".wav") String
s) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
dir0N
      l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
diNN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  Array Int String -> IO (Array Int String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int) -> [String] -> Array Int String
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) [String]
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 'Array' 'Int' of specially formatted
-- 'String' that represents only those files that are connected with the replacement procedure.
playAndMark :: [FilePath] -> IO [String]
playAndMark :: [String] -> IO [String]
playAndMark [String]
xss = do
  [String]
yss <- ((String, Integer) -> IO String)
-> [(String, Integer)] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(String
xs, Integer
i) -> do
      String -> IO ()
putStrLn String
"Listen to the next sound, please. Please, do not enter anything while sound plays. "
      String -> IO ()
playA String
xs
      String -> IO ()
putStr String
"How do you mark the file that has just been played now -- if of high quality, print \"1\", if of low quality, print \"0\", "
      String -> IO ()
putStrLn String
"if it is just accepted, press \'Enter\'. "  
      String
mark0 <- IO String
getLine
      String -> IO ()
putStrLn String
"-----------------------------------------------------------------------------------------"
      let mark :: String
mark = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
mark0
      case String
mark of
        String
"1" -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs
        String
"0" -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"**" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs
        String
_   -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return []) ([(String, Integer)] -> IO [String])
-> ([Integer] -> [(String, Integer)]) -> [Integer] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Integer] -> [(String, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
xss ([Integer] -> IO [String]) -> [Integer] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [Integer
0..]
  [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
yss

-- | Function 'playAndMark' applied to all the \"result\*.wav\" files in the current directory.
playAMrk :: IO [String]
playAMrk :: IO [String]
playAMrk = String -> IO [String]
playAMrk2G String
"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 [String]
playAMrk2G :: String -> IO [String]
playAMrk2G String
ys = String -> IO [String]
listVDirectory2G String
ys IO [String] -> ([String] -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO [String]
playAndMark

-- | Function-predicate to check whether a file corresponding to its 'String' argument is needed to be replaced while processing.
shouldBeReplaced :: String -> Bool
shouldBeReplaced :: String -> Bool
shouldBeReplaced (Char
x:Char
y:String
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 = String -> Bool
shouldBeReplaced (Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
shouldBeReplaced String
_ = 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 :: String -> Bool
isHighQ String
xs = (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (String -> String) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*') (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

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

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

-- | Axiliary function to get a 'String' of consequent digits in the name of the \"result\*.wav\" file.
ixFromRes :: String -> String
ixFromRes :: String -> String
ixFromRes String
xs = ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') String
xs) String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"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 = String -> Int -> IO (Int, Int)
ixInterv2G String
"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 :: String -> Int -> IO (Int, Int)
ixInterv2G String
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
      [String]
dirV <- String -> IO [String]
listVDirectory2G String
ys
      let l1 :: Int
l1 = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dirV
      case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l1 Int
13 of
        Ordering
LT -> (Int, Int) -> IO (Int, Int)
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 (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
      [String]
dirV <- String -> IO [String]
listVDirectory2G String
ys
      let l1 :: Int
l1 = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dirV
      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 (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 (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
      [String]
dirV <- String -> IO [String]
listVDirectory2G String
ys
      let l1 :: Int
l1 = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dirV
      case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l1 Int
13 of
       Ordering
LT -> (Int, Int) -> IO (Int, Int)
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 (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 (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 :: [String] -> [([Int], [String])]
infoFromV :: [String] -> [([Int], [String])]
infoFromV [String]
xss = ([String] -> ([Int], [String]))
-> [[String]] -> [([Int], [String])]
forall a b. (a -> b) -> [a] -> [b]
map (([String], [String]) -> ([Int], [String])
internalConv (([String], [String]) -> ([Int], [String]))
-> ([String] -> ([String], [String]))
-> [String]
-> ([Int], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, String)] -> ([String], [String]))
-> ([String] -> [(String, String)])
-> [String]
-> ([String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*'))) [[String]
v1, [String]
v2]
  where ([String]
v1, [String]
v2) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition String -> Bool
shouldBeReplaced [String]
xss

-- | Plays a sequence of sounds in the interval of them obtained by 'ixInterv' function.
playSeqAR :: Int -> IO ()
playSeqAR :: Int -> IO ()
playSeqAR = String -> Int -> IO ()
playSeqAR2G String
"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 :: String -> Int -> IO ()
playSeqAR2G String
ys Int
index0 = do
  (Int
minBnd,Int
maxBnd) <- String -> Int -> IO (Int, Int)
ixInterv2G String
ys Int
index0
  Array Int String
dirV2 <- String -> String -> IO (Array Int String)
listVDirectory3G String
ys String
"result"
  (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
playA (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int String -> Int -> String
forall i e. Array i e -> Int -> e
unsafeAt Array Int String
dirV2) [Int
minBnd..Int
maxBnd]  

playA :: String -> IO ()
playA String
file = String -> [String] -> IO ()
playE String
file []
{-# INLINE playA #-}

-- | Plays a sequence of consequential sounds in the melody in the interval of them obtained by 'ixInterv' function for each element index
-- from ['Int'] of indexes.
playSeqARV :: [Int] -> IO ()
playSeqARV :: [Int] -> IO ()
playSeqARV = String -> [Int] -> IO ()
playSeqARV2G String
"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 -> [Int] -> IO ()
playSeqARV2G :: String -> [Int] -> IO ()
playSeqARV2G String
ys [Int]
xs = do
  Array Int String
dirV2 <- String -> String -> IO (Array Int String)
listVDirectory3G String
ys String
"result"
  (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
x -> String -> IO ()
playA (Array Int String -> Int -> String
forall i e. Array i e -> Int -> e
unsafeAt Array Int String
dirV2 Int
x)) [Int]
xs


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

-- | Plays a sequence of sounds considered of higher quality.
playSeqARV22G :: String -> [String] -> IO ()
playSeqARV22G :: String -> [String] -> IO ()
playSeqARV22G String
ys [String]
vec = do
  let indexesHQs :: [Int]
indexesHQs = ([Int], [String]) -> [Int]
forall a b. (a, b) -> a
fst (([Int], [String]) -> [Int])
-> ([String] -> ([Int], [String])) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Int], [String])] -> ([Int], [String])
forall a. [a] -> a
last ([([Int], [String])] -> ([Int], [String]))
-> ([String] -> [([Int], [String])])
-> [String]
-> ([Int], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [([Int], [String])]
infoFromV ([String] -> [Int]) -> [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ [String]
vec  
  String -> [Int] -> IO ()
playSeqARV2G String
ys [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 :: [String] -> IO [Bool]
playCollectDec :: [String] -> IO [Bool]
playCollectDec = String -> [String] -> IO [Bool]
playCollectDec2G String
"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 -> [String] -> IO [Bool]
playCollectDec2G :: String -> [String] -> IO [Bool]
playCollectDec2G String
ys [String]
arr = do
  Array Int String
dirV3 <- String -> String -> IO (Array Int String)
listVDirectory3G String
ys String
"result"
  let indexesHQs :: [Int]
indexesHQs = ([Int], [String]) -> [Int]
forall a b. (a, b) -> a
fst (([Int], [String]) -> [Int])
-> ([String] -> ([Int], [String])) -> [String] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Int], [String])] -> ([Int], [String])
forall a. [a] -> a
last ([([Int], [String])] -> ([Int], [String]))
-> ([String] -> [([Int], [String])])
-> [String]
-> ([Int], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [([Int], [String])]
infoFromV ([String] -> [Int]) -> [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ [String]
arr
  (Int -> IO Bool) -> [Int] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Array Int String -> Int -> IO Bool
playCollect1Dec Array Int String
dirV3) [Int]
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 -> [Bool] -> [FilePath] -> IO ()
replaceWithHQs :: String -> [Bool] -> [String] -> IO ()
replaceWithHQs = String -> String -> [Bool] -> [String] -> IO ()
replaceWithHQs2G String
"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 -> [Bool] -> [FilePath] -> IO ()
replaceWithHQs2G :: String -> String -> [Bool] -> [String] -> IO ()
replaceWithHQs2G String
ys String
file0 [Bool]
vecBools0 [String]
stringHQs0 = do
   let zipp :: [(Bool, String)]
zipp = [Bool] -> [String] -> [(Bool, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
vecBools0 [String]
stringHQs0
       l :: Int
l = [(Bool, String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, String)]
zipp
       ([Bool]
vecBools, [String]
stringHQs) = [(Bool, String)] -> ([Bool], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Bool, String)]
zipp
   case Int
l of
    Int
0 -> String -> IO ()
putStrLn String
"That's all!"
    Int
1 | [Bool] -> Bool
forall a. [a] -> a
head [Bool]
vecBools -> do
         String -> String -> IO ()
copyFile ([String] -> String
forall a. [a] -> a
head [String]
stringHQs) (String
"resultI." String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
"flac" else String
"wav")
         String -> String -> IO ()
renameFile (String
"resultI." String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
"flac" else String
"wav") String
file0
      | Bool
otherwise -> String -> IO ()
putStrLn String
"Nothing has changed. "
    Int
_ -> do
         let yss :: [String]
yss = ((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Bool) -> String
forall a b. (a, b) -> a
fst ([(String, Bool)] -> [String])
-> ([Bool] -> [(String, Bool)]) -> [Bool] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(String, Bool)] -> [(String, Bool)])
-> ([Bool] -> [(String, Bool)]) -> [Bool] -> [(String, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Bool] -> [(String, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
stringHQs ([Bool] -> [String]) -> [Bool] -> [String]
forall a b. (a -> b) -> a -> b
$ [Bool]
vecBools
         case [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
yss of
          Int
0 -> String -> IO ()
putStrLn String
"That's all!"
          Int
1 -> String -> String -> IO ()
copyFile ([String] -> String
forall a. [a] -> a
head [String]
yss) String
file0
          Int
_ -> do
            (ExitCode
_,String
_,String
herr) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String]
yss [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String] -> [String]
soxBasicParams String
ys [String
"",String
file0]) String
""
            String -> IO ()
putStrLn String
herr

-- | '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
  String -> IO ()
putStrLn String
"Would you like to add this sound played just now to the sequence of sounds that will replace the needed one? "
  String
yes <- IO String
getLine
  String -> IO ()
putStrLn String
"-----------------------------------------------------------------------"
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
yes String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"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 :: Array Int String -> Int -> IO Bool
playCollect1Dec :: Array Int String -> Int -> IO Bool
playCollect1Dec Array Int String
dirV2 Int
i 
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Array Int String -> Int
forall i e. Array i e -> Int
numElements Array Int String
dirV2) = do 
     String -> [String] -> IO ()
playE (Array Int String -> Int -> String
forall i e. Array i e -> Int -> e
unsafeAt Array Int String
dirV2 Int
i) []
     IO Bool
thisOne
  | Bool
otherwise = String -> IO Bool
forall a. HasCallStack => String -> a
error String
"Composition.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 :: [String] -> IO [String]
pAnR1 :: [String] -> IO [String]
pAnR1 = String -> [String] -> IO [String]
pAnR12G String
"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 -> [String] -> IO [String]
pAnR12G :: String -> [String] -> IO [String]
pAnR12G String
ys [String]
vec
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
vec = String -> IO ()
putStrLn String
"You have processed all the marked files! " IO () -> IO [String] -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
 | Bool
otherwise = do
    let [([Int]
indexes0,[String]
strings),([Int]
indexesHQ,[String]
stringHQs)] = [String] -> [([Int], [String])]
infoFromV [String]
vec
    String -> IO ()
putStrLn String
"Please, listen to the melody and remember what sound you would like to replace and the surrounding sounds. "
    String -> Int -> IO ()
playSeqAR2G String
ys (Int -> IO ()) -> ([Int] -> Int) -> [Int] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. [a] -> a
head ([Int] -> IO ()) -> [Int] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Int]
indexes0
    String -> IO ()
putStrLn String
"---------------------------------------------------------------"
    String -> IO ()
putStrLn String
"Now, please, listen to a collection of sounds considered of higher quality which you can use to replace the needed one. "
    [Bool]
vecBools <- String -> [String] -> IO [Bool]
playCollectDec2G String
ys [String]
vec
    String -> String -> [Bool] -> [String] -> IO ()
replaceWithHQs2G String
ys ([String] -> String
forall a. [a] -> a
head [String]
strings) [Bool]
vecBools [String]
stringHQs
    [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
ix,String
xs) -> Int -> String
forall a. Show a => a -> String
show Int
ix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"**" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs) ([(Int, String)] -> [String])
-> ([String] -> [(Int, String)]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
indexes0) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
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 :: [String] -> IO ()
pAnR2 :: [String] -> IO ()
pAnR2 = String -> [String] -> IO ()
pAnR22G String
"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 -> [String] -> IO ()
pAnR22G :: String -> [String] -> IO ()
pAnR22G String
ys [String]
vec
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
vec = String -> IO ()
putStrLn String
"You have processed all the marked files! "
 | Bool
otherwise = IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (String -> [String] -> IO [String]
pAnR12G String
ys [String]
vec IO [String] -> ([String] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> [String] -> IO ()
pAnR22G String
ys) (() -> IO ()
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_ = String -> IO ()
pAnR_2G String
"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 :: String -> IO ()
pAnR_2G String
ys = do
  [String]
vec <- String -> IO [String]
playAMrk2G String
ys
  String -> [String] -> IO ()
pAnR22G String
ys [String]
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 :: String -> [String] -> IO ()
reverbE String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file,String
"reverb"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file) String
file
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.reverbE \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> IO ()
reverbE2C String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file,String
"reverb"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> do { String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file) (String -> String
cfw2wf String
file) ; String -> IO ()
removeFile String
file }
    ExitCode
_           -> do { String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file
                      ; String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.reverbE2C \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> IO ()
reverb1E String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file,String
"reverb"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"channels",String
"1"]) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file) String
file
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.reverb1E \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> IO ()
reverb1E2C String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file,String
"reverb"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"channels",String
"1"]) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> do { String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file) (String -> String
cfw2wf String
file) ; String -> IO ()
removeFile String
file }
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverb1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.reverb1E2C \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> IO ()
reverbWE String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file,String
"reverb",String
"-w"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file) String
file
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.reverbWE \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> IO ()
reverbWE2C String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file,String
"reverb",String
"-w"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> do { String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file) (String -> String
cfw2wf String
file) ; String -> IO ()
removeFile String
file }
    ExitCode
_           -> do { String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file
                      ; String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.reverbWE2C \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> IO ()
reverbW1E String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file,String
"reverb",String
"-w"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"channels",String
"1"]) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file) String
file
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.reverbW1E \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> IO ()
reverb1WE2C String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file,String
"reverb",String
"-w"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"channels",String
"1"]) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> do { String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file) (String -> String
cfw2wf String
file) ; String -> IO ()
removeFile String
file }
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverbW1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.reverb1WE2C \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> [String]
soxBasicParams String
ys [String]
xss 
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = []
 | Bool
otherwise =
    let (String
ts,String
zs) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 (String -> (String, String))
-> (String -> String) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
init (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String
ys in (String -> [(String, String)] -> String -> String
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' String
"-r22050" ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"11",String
"16", String
"17", String
"19", String
"32", String
"44", String
"48", String
"80", String
"96"] ([String] -> [(String, String)]) -> [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$
      [String
"-r11025",String
"-r16000",String
"-r176400",String
"-r192000",String
"-r32000",String
"-r44100",String
"-r48000",String
"-r8000",String
"-r96000"]) String
ts) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (if String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"2" then String
"-b24" else String
"-b16") String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
        ((if Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> if Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".wav" then Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".flac" else String
xs) else [String] -> [String]
forall a. a -> a
id) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
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 :: String -> [String] -> IO ()
soxE2C String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> do { String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file) (String -> String
cfw2wf String
file) ; String -> IO ()
removeFile String
file }
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.soxE2C \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> IO ()
soxE1 String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"channels",String
"1"]) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file) String
file
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2 String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.soxE1 \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 :: String -> [String] -> IO ()
soxE12C String
file [String]
arggs = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"channels",String
"1"]) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> do { String -> String -> IO ()
renameFile (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file) (String -> String
cfw2wf String
file) ; String -> IO ()
removeFile String
file }
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
efw2vv String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.IntermediateF.soxE12C \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" 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 'SoXBasics.recA' function.
recE :: FilePath -> [String] -> IO ()
recE :: String -> [String] -> IO ()
recE String
file [String]
arggs | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
5 String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw" = do 
  (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
"-t",String
"waveaudio",String
"-d", String
file] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs)String
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- String -> IO Bool
doesFileExist String
file
      if Bool
e0
        then do
          String -> IO ()
removeFile String
file
          FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
    else do
      Bool
e1 <- String -> IO Bool
doesFileExist String
file
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
                 | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"rec") = do
  (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"rec")) (String
fileString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
arggs) String
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- String -> IO Bool
doesFileExist String
file
      if Bool
e0
        then do
          String -> IO ()
removeFile String
file
          FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
    else do
      Bool
e1 <- String -> IO Bool
doesFileExist String
file
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
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 'SoXBasics.recA' function.
rec1E :: FilePath -> [String] -> IO ()
rec1E :: String -> [String] -> IO ()
rec1E String
file [String]
arggs | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
5 String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw" = do 
  (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
"-t",String
"waveaudio",String
"-d", String
file] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"channels",String
"1"])String
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- String -> IO Bool
doesFileExist String
file
      if Bool
e0
        then do
          String -> IO ()
removeFile String
file
          FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
    else do
      Bool
e1 <- String -> IO Bool
doesFileExist String
file
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
                 | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"rec") = do
  (ExitCode
code, String
_, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"rec")) ([String
file] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"channels",String
"1"]) String
""
  if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- String -> IO Bool
doesFileExist String
file
      if Bool
e0
        then do
          String -> IO ()
removeFile String
file
          FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
file)
    else do
      Bool
e1 <- String -> IO Bool
doesFileExist String
file
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (String -> FinalException
NotRecorded String
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 'SoXBasics.playA' function.
playE :: FilePath -> [String] -> IO ()
playE :: String -> [String] -> IO ()
playE String
file [String]
arggs | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
5 String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw" = 
  if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"sox") 
    then IO (ExitCode, String, String) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String
file, String
"-t", String
"waveaudio", String
"-d"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs)) String
"")
    else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled
                 | Bool
otherwise = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe String
showE String
"play") 
  then IO (ExitCode, String, String) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"play")) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String
file] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs)) String
"")
  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 :: String -> IO ()
getSilenceF String
file = String -> [String] -> IO ()
soxE String
file [String
"vol",String
"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 :: String -> String -> IO ()
fadeAllE String
ys String
zs = String -> String -> IO (Array Int String)
listVDirectory3G String
ys String
zs IO (Array Int String) -> (Array Int String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Array Int String
arr -> (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
fadeEnds ([String] -> IO ())
-> (Array Int String -> [String]) -> Array Int String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int String -> [String]
forall i e. Array i e -> [e]
elems (Array Int String -> IO ()) -> Array Int String -> IO ()
forall a b. (a -> b) -> a -> b
$ Array Int String
arr 

-- | 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 -> String -> String -> IO ()
fadeAllEMilN Int
n String
ys String
zs = String -> String -> IO (Array Int String)
listVDirectory3G String
ys String
zs IO (Array Int String) -> (Array Int String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Array Int String
arr -> (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> String -> IO ()
fadeEndsMilN Int
n) ([String] -> IO ())
-> (Array Int String -> [String]) -> Array Int String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int String -> [String]
forall i e. Array i e -> [e]
elems (Array Int String -> IO ()) -> Array Int String -> IO ()
forall a b. (a -> b) -> a -> b
$ Array Int String
arr

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

-- | A predicate to decide whether an element @a@ belongs to the odd number of the lists of @a@.
isOddAsElem :: Eq a => a -> [[a]] -> Bool
isOddAsElem :: a -> [[a]] -> Bool
isOddAsElem a
x [[a]]
v
  | [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
v = Bool
False
  | Bool
otherwise = ([[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[a]] -> Int) -> ([[a]] -> [[a]]) -> [[a]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x) ([[a]] -> Int) -> [[a]] -> Int
forall a b. (a -> b) -> a -> b
$ [[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 the [[a]] must have finite length.
-- If the argument is [] 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 => [[a]] -> Maybe a
maxLinV :: [[a]] -> Maybe a
maxLinV [[a]]
v
  | ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
v  Bool -> Bool -> Bool
|| [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
v = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([a] -> a) -> ([[a]] -> [a]) -> [[a]] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([[a]] -> [a]) -> ([[a]] -> [[a]]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[a]] -> a) -> [[a]] -> a
forall a b. (a -> b) -> a -> b
$ [[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 the [[a]] must have finite length.
-- If the argument is [] 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 => [[a]] -> Maybe a
minLinV :: [[a]] -> Maybe a
minLinV [[a]]
v
  | ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
v Bool -> Bool -> Bool
|| [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
v = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([a] -> a) -> ([[a]] -> [a]) -> [[a]] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([[a]] -> [a]) -> ([[a]] -> [[a]]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[a]] -> a) -> [[a]] -> a
forall a b. (a -> b) -> a -> b
$ [[a]]
v)

-- | Applied to list of @[a]@ where a is an instance for 'Ord' class gives a sorted in the ascending order [[a]], each of them being unique.
doubleLtoV :: Ord a => [[a]] -> [a]
doubleLtoV :: [[a]] -> [a]
doubleLtoV = [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 (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 -> String -> IO ()
soxREw1 Int
reverberance Int
damping Int
roomscale Int
stereodepth Int
predelay Int
wetgain String
file = do 
  Float
durat <- String -> IO Float
durationA String
file
  String -> [String] -> IO ()
soxE String
file ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"channels", String
"2", String
"rate", String
"44100", String
"reverb", String
"-w"], (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> Int -> String
forall a. Show a => a -> String
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)) [Int
reverberance, Int
damping, Int
roomscale, Int
stereodepth], 
    [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
predelay Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
501), Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
wetgain Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
7), String
"trim", String
"0", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5) Float
durat String
"", String
"reverse", String
"fade", String
"q", String
"0.002", String
"-0.0", String
"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 -> String -> IO ()
soxRE1 Int
reverberance Int
damping Int
roomscale Int
stereodepth Int
predelay Int
wetgain String
file = do 
  Float
durat <- String -> IO Float
durationA String
file
  String -> [String] -> IO ()
soxE String
file ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"channels", String
"2", String
"rate", String
"44100", String
"reverb"], (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> Int -> String
forall a. Show a => a -> String
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)) [Int
reverberance, Int
damping, Int
roomscale, Int
stereodepth],  
    [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
predelay Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
501), Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
wetgain Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
7), String
"trim", String
"0", Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5) Float
durat String
"", String
"reverse", String
"fade", String
"q", String
"0.002", String
"-0.0", String
"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).
-- Works well with the number of the files not exceeding several hundreds. Otherwise, can lead to resource leakage and
-- in such a case 'soxREAS1' is recommended to be used instead.
soxREA1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> String -> String -> FilePath -> IO ()
soxREA1 :: Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> String
-> String
-> String
-> IO ()
soxREA1 Int
reverberance Int
damping Int
roomscale Int
stereodepth Int
predelay Int
wetgain Int
reverb2 String
ys String
zs String
file = do 
  Array Int String
dir0V <- String -> String -> IO (Array Int String)
listVDirectory3G String
ys String
zs
  let dir0L :: [String]
dir0L = Array Int String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Array Int String
dir0V
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
file -> IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Int -> Int -> Int -> Int -> Int -> Int -> String -> IO ()
soxREw1 Int
reverberance Int
damping Int
roomscale Int
stereodepth Int
predelay Int
wetgain String
file) (\IOException
e -> do -- this for the catch is taken from the Control.Exception module from the @base@ package.
     let err :: String
err = IOException -> String
forall a. Show a => a -> String
show (IOException
e :: IOException)
     Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Warning: SoX exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
     () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) [String]
dir0L
  (ExitCode
_,String
_,String
herr) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]
dir0L, [String
file, String
"reverb", Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
reverb2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
101)]]) String
""
  String -> IO ()
forall a. Show a => a -> IO ()
print String
herr
  
-- | 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).
-- Has some complex processment (see for details: 'seqFlsReadProcessWithExitCode') and is recommended if the directory
-- contains hundreds of the input needed files.
soxREAS1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> String -> String -> FilePath -> IO ()
soxREAS1 :: Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> String
-> String
-> String
-> IO ()
soxREAS1 Int
reverberance Int
damping Int
roomscale Int
stereodepth Int
predelay Int
wetgain Int
reverb2 String
ys String
zs String
file = do 
  Array Int String
dir0V <- String -> String -> IO (Array Int String)
listVDirectory3G String
ys String
zs
  let dir0L :: [String]
dir0L = Array Int String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Array Int String
dir0V
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
file -> IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Int -> Int -> Int -> Int -> Int -> Int -> String -> IO ()
soxREw1 Int
reverberance Int
damping Int
roomscale Int
stereodepth Int
predelay Int
wetgain String
file) (\IOException
e -> do -- this for the catch is taken from the Control.Exception module from the @base@ package.
     let err :: String
err = IOException -> String
forall a. Show a => a -> String
show (IOException
e :: IOException)
     Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Warning: SoX exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
     () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) [String]
dir0L
  let thesame :: String
thesame = ((Char, Char) -> Char) -> [(Char, Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Char
forall a b. (a, b) -> a
fst ([(Char, Char)] -> String)
-> (Int -> [(Char, Char)]) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Char) -> Bool) -> [(Char, Char)] -> [(Char, Char)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Char
x,Char
y) -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y) ([(Char, Char)] -> [(Char, Char)])
-> (Int -> [(Char, Char)]) -> Int -> [(Char, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Array Int String -> Int -> String
forall i e. Array i e -> Int -> e
unsafeAt Array Int String
dir0V Int
0) (String -> [(Char, Char)])
-> (Int -> String) -> Int -> [(Char, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int String -> Int -> String
forall i e. Array i e -> Int -> e
unsafeAt Array Int String
dir0V (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
1
      f :: String -> String
f String
rs = String
ks String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
zs) String
rs
          where ks :: String
ks
                 | String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"result" = String
"intermediate"
                 | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"intermediate" String
rs = String
"end"
                 | Bool
otherwise = String
"intermedresult"
      ns :: [Int]
ns = [Int
100,Int
80,Int
75,Int
90,Int
85]
      g_N :: a -> a
g_N = a -> a
forall a. a -> a
id
      h_S :: p -> p -> [String]
h_S p
xs p
_ = [String
"earwax"]
  ([String], [Int], [String], Int)
_ <- String
-> Int
-> (String -> String)
-> String
-> [Int]
-> ([Int] -> [Int])
-> ([String] -> Int -> [String])
-> [String]
-> String
-> IO ([String], [Int], [String], Int)
seqFlsReadProcessWithExitCode String
"sox" Int
2 String -> String
f String
thesame [Int]
ns [Int] -> [Int]
forall a. a -> a
g_N [String] -> Int -> [String]
forall p p. p -> p -> [String]
h_S [String
"reverb", Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
reverb2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
101)] []
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()