-- |
-- Module      :  Composition.Sound.SoX
-- Copyright   :  (c) Oleksandr Zhabenko 2019-2024
-- License     :  MIT
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Some functionality that is primarily implemented using 'String' and 'System.Process' in the algorithmic-composition-basic and related packages. Is rewritten and groupped to be probably more suitable for concurrent and asynchronous usage.

{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, OverloadedLists #-}
{-# OPTIONS_HADDOCK -show-extensions #-}


module Composition.Sound.SoX where

import GHC.Base hiding (foldr) 
import GHC.Num ((+),(*))
import GHC.Real (fromIntegral,rem,(/))
import Text.Show (Show(..))
import Text.Read
import Data.Tuple (fst)
import Data.List hiding (lines,words,take,head,uncons,foldr,dropWhile) 
import System.Directory
import System.IO (FilePath, stderr, putStrLn)
import Data.ByteString.Lazy hiding (null,take,filter,isSuffixOf,foldr,dropWhile)
import Data.ByteString.Lazy.Char8 (lines,words,take,foldr,dropWhile)  
--import System.Exit (ExitCode(ExitSuccess))
import EndOfExe2 (showE0Dup)
import Numeric (showFFloat)
import Data.InsertLeft (takeFromEndG, splitAtEndG)
import System.Process.Typed

type SoXEffects = [String]

-- Taken from the Composition.Sound.IntermediateF module from @algorithmic-composition-basic@ here so that they are more used this way.  

-- | Takes a filename to be applied a SoX chain of effects as list of 'String' (the second argument). Produces the temporary
-- new file with the name ((name-of-the-file) ++ (\"effects.wav\"  OR \"effects.flac\") -- the type is preserved), which then is removed. 
--
-- The syntaxis is that every separate literal for SoX must be a new element in the list. Please, for more information, refer to SoX documentation.
-- Please, check by yourself whether you have enough permissions to work with the corresponding 'FilePath's.
soxE :: FilePath -> SoXEffects -> IO ()
soxE :: String -> [String] -> IO ()
soxE String
file [String]
arggs = do
  let effile :: String
effile = 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
  (ExitCode
code,ByteString
_,ByteString
herr) <- ProcessConfig () () () -> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (String -> [String] -> ProcessConfig () () ()
proc (String -> String
showE0Dup String
"sox") ([String
Item [String]
file,String
Item [String]
effile] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
arggs))
  case ExitCode
code of
    ExitCode
ExitSuccess -> String -> String -> IO ()
renameFile String
effile String
file
    ExitCode
_ -> do
       Bool
exist <- String -> IO Bool
doesFileExist String
effile
       if Bool
exist then do 
                  Handle -> ByteString -> IO ()
hPut Handle
stderr ByteString
herr
                  String -> IO ()
removeFile String
effile
                  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.SoX.soxE: Applying SoX on the file \"" 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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has not been changed at all. "
       else do
         Handle -> ByteString -> IO ()
hPut Handle
stderr ByteString
herr
         String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Composition.Sound.SoX.soxE: Creation of the file \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
effile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" has not been successful. The file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has not been changed at all. "

w2f :: FilePath -> FilePath
w2f :: String -> String
w2f String
file 
  | String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".wav" = String
zs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".flac" 
  | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.w2f: The file is not a WAV file! "
      where (String
zs,String
ts) = Integer -> String -> (String, String)
forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> (t a, t a)
splitAtEndG Integer
4 String
file  
{-# INLINE w2f #-}

f2w :: FilePath -> FilePath
f2w :: String -> String
f2w String
file 
  | String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".flac" = String
zs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".wav" 
  | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.f2w: The file is not a FLAC file! "
      where (String
zs,String
ts) = Integer -> String -> (String, String)
forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> (t a, t a)
splitAtEndG Integer
5 String
file
{-# INLINE f2w #-}

wOrf :: FilePath -> String
wOrf :: String -> String
wOrf String
file 
  | String
us String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".wav" = String
"w"
  | String
us String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flac" = String
"f"
  | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.wOrf: The file is neither a WAV nor a FLAC file!"
      where us :: String
us = Integer -> String -> String
forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> t a
takeFromEndG Integer
4 String
file 
{-# INLINE wOrf #-}

cfw2wf :: FilePath -> FilePath
cfw2wf :: String -> String
cfw2wf String
file
 | String
wf String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"w" = String -> String
w2f String
file
 | String
wf String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" = String -> String
f2w String
file
 | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.cfw2wf: The file is neither a WAV nor a FLAC file! "
     where wf :: String
wf = String -> String
wOrf String
file
{-# INLINE cfw2wf #-}

efw2 :: FilePath -> String
efw2 :: String -> String
efw2 String
file 
 | String
us String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".wav" = String
us
 | String
us String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flac" = Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
us
 | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.efw2: The file is neither a WAV nor a FLAC file!"
     where us :: String
us = Integer -> String -> String
forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> t a
takeFromEndG Integer
4 String
file
{-# INLINE efw2 #-}

efw2vv :: FilePath -> String
efw2vv :: String -> String
efw2vv String
file 
 | String
us String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".wav" = String
".flac"
 | String
us String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flac" = String
".wav"
 | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.efw2vv: The file is neither a WAV nor a FLAC file! "
     where us :: String
us = Integer -> String -> String
forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> t a
takeFromEndG Integer
4 String
file 
{-# INLINE efw2vv #-}

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

-- | Applies \"fade q\" effect to both ends of the supported by SoX sound file 'FilePath' so that concatenating them consequently after such application 
-- leads to no clipping. Otherwise, the clipping exists if not prevented by may be some other means. For more information, please, refer to the
-- SoX documentation.
fadeEnds :: FilePath -> IO ()
fadeEnds :: String -> IO ()
fadeEnds = Int -> String -> IO ()
fadeEndsMilN Int
10
{-# INLINE fadeEnds #-}

-- | Applies \"fade q\" effect to both ends of the supported by SoX sound file 'FilePath' so that concatenating them consequently after such application 
-- leads to no clipping. Otherwise, the clipping exists if not prevented by may be some other means. The duration of the changes are usually 
-- smaller than for 'fadeEnds' function and is equal to 0.001 \* n sec (where n is in range [1..10]). 
-- For more information, please, refer to the SoX documentation.
fadeEndsMilN :: Int -> FilePath -> IO ()
fadeEndsMilN :: Int -> String -> IO ()
fadeEndsMilN Int
n String
file = String -> [String] -> IO ()
soxE String
file [String
Item [String]
"fade",String
Item [String]
"q", Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (if (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
11) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then Double
0.001 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
11) else Double
0.002) String
"",String
Item [String]
"-0.0"]

-- | Applies \"fade\" effect (the type is specified by the 'Char' argument, for more information, please, refer to the SoX documentation) to the both ends 
-- of the sound with header (supported by SoX). The 'Float' arguments specify the percentages of the length of the sound that is faded-in and faded-out 
-- respectively. Otherwise, the function returns an error.
fadeEndsTMN :: Char -> Float -> Float -> FilePath -> IO ()
fadeEndsTMN :: Char -> Float -> Float -> String -> IO ()
fadeEndsTMN Char
c Float
per1 Float
per2 String
file 
 | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
per1 Float
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
per2 Float
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float
per1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
per2) Float
100 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = do
    Float
d0 <- String -> IO Float
durationA String
file
    String -> [String] -> IO ()
soxE String
file [String
Item [String]
"fade", case Char
c of {Char
'h' -> String
Item [String]
"h"; Char
'p' -> String
Item [String]
"p"; Char
'q' -> String
Item [String]
"q"; Char
't' -> String
Item [String]
"t"; ~Char
_ -> String
Item [String]
"l"}, 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
4) (Float
d0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
per1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100.0) String
"",String
Item [String]
"-0.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
4) (Float
d0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
per2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100.0) String
""]
 | Bool
otherwise = String -> IO ()
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.fadeEndsTMN: the percentages sum is out of the (0..100] range. "

-- | Variant of the 'fadeEndsTMN' with the both equal percentages specified by the 'Float' argument. It must be in the range (0..50]. Otherwise, the function 
-- returns error.
fadeEndsTMB :: Char -> Float -> FilePath -> IO ()
fadeEndsTMB :: Char -> Float -> String -> IO ()
fadeEndsTMB Char
c Float
per 
 | Float
per Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Float
per Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
50 = Char -> Float -> Float -> String -> IO ()
fadeEndsTMN Char
c Float
per Float
per
 | Bool
otherwise = String -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.fadeEndsTMB: The percentage is out of the (0..50] range. "
{-# INLINE fadeEndsTMB #-}

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

takeU :: ByteString -> ByteString
takeU :: ByteString -> ByteString
takeU ByteString
u
 | Int64 -> ByteString -> ByteString
take Int64
1 ByteString
u ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"-" = Int64 -> ByteString -> ByteString
take Int64
9 ByteString
u
 | Bool
otherwise = Int64 -> ByteString -> ByteString
take Int64
8 ByteString
u
{-# INLINE takeU #-}

-- | Function 'getMaxAG' returns a maximum amplitude of the sound in the file in the given lower and upper bounds represented as a tuple of 'Int' values.
getMaxAG :: ULencode -> FilePath -> (Int, Int) -> IO ByteString
getMaxAG :: ULencode -> String -> (Int, Int) -> IO ByteString
getMaxAG ULencode
ul String
file (Int
lowerbound, Int
upperbound) 
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
showE0Dup (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"sox" =   String -> IO ByteString
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.getMinAG: The SoX executable is not properly installed."
  | Bool
otherwise = do
     (ExitCode
_, ByteString
_, ByteString
herr) <- ULencode
-> [String]
-> String
-> [String]
-> [String]
-> IO (ExitCode, ByteString, ByteString)
soxOpG1 ULencode
ul [] String
file [] [String
Item [String]
"trim", Int -> String
forall a. Show a => a -> String
show Int
lowerbound String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s", String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
upperbound String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s", String
Item [String]
"stat"]
     let zs :: [ByteString]
zs = ByteString -> [ByteString]
lines ByteString
herr 
     ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (let u :: ByteString
u = (ByteString -> [ByteString]
words (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
zs [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! Int
2 in ByteString -> ByteString
takeU ByteString
u)

-- | Function 'getMinAG' returns a minimum amplitude of the sound in the file in the given lower and upper bounds represented as a tuple of 'Int' values.
getMinAG :: ULencode -> FilePath -> (Int, Int) -> IO ByteString
getMinAG :: ULencode -> String -> (Int, Int) -> IO ByteString
getMinAG ULencode
ul String
file (Int
lowerbound, Int
upperbound) 
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
showE0Dup (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"sox" = String -> IO ByteString
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.getMinAG: The SoX executable is not properly installed."
  | Bool
otherwise = do
      (ExitCode
_, ByteString
_, ByteString
herr1) <- ULencode
-> [String]
-> String
-> [String]
-> [String]
-> IO (ExitCode, ByteString, ByteString)
soxOpG1 ULencode
ul [] String
file [] [String
Item [String]
"trim", Int -> String
forall a. Show a => a -> String
show Int
lowerbound String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s", String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
upperbound String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s", String
Item [String]
"stat"]
      let zs :: [ByteString]
zs = ByteString -> [ByteString]
lines ByteString
herr1
      ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (let u :: ByteString
u = (ByteString -> [ByteString]
words (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
zs [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! Int
4) [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! Int
2 in ByteString -> ByteString
takeU ByteString
u)
 
-- | Function 'selMaxAbsG' returns a maximum by absolute value amplitude of the sound and allows by its second value in the tuple determine whether it is a maximum or minimum.
-- Bool 'True' corresponds to maximum value, 'False' - to minimum value.
selMaxAbsG :: ULencode -> FilePath -> (Int, Int) -> IO (ByteString, Bool)
selMaxAbsG :: ULencode -> String -> (Int, Int) -> IO (ByteString, Bool)
selMaxAbsG ULencode
ul String
file (Int
lowerbnd, Int
upperbnd) = do
  ByteString
tX <- ULencode -> String -> (Int, Int) -> IO ByteString
getMaxAG ULencode
ul String
file (Int
lowerbnd, Int
upperbnd)
  ByteString
tN <- ULencode -> String -> (Int, Int) -> IO ByteString
getMinAG ULencode
ul String
file (Int
lowerbnd, Int
upperbnd)
  (ByteString, Bool) -> IO (ByteString, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteString) -> (ByteString, Bool)
maxAbs (ByteString
tX, ByteString
tN))

data ULencode = W | UL1 | UL0 | UL deriving (ULencode -> ULencode -> Bool
(ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> Bool) -> Eq ULencode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ULencode -> ULencode -> Bool
== :: ULencode -> ULencode -> Bool
$c/= :: ULencode -> ULencode -> Bool
/= :: ULencode -> ULencode -> Bool
Eq, Eq ULencode
Eq ULencode =>
(ULencode -> ULencode -> Ordering)
-> (ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> Bool)
-> (ULencode -> ULencode -> ULencode)
-> (ULencode -> ULencode -> ULencode)
-> Ord ULencode
ULencode -> ULencode -> Bool
ULencode -> ULencode -> Ordering
ULencode -> ULencode -> ULencode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ULencode -> ULencode -> Ordering
compare :: ULencode -> ULencode -> Ordering
$c< :: ULencode -> ULencode -> Bool
< :: ULencode -> ULencode -> Bool
$c<= :: ULencode -> ULencode -> Bool
<= :: ULencode -> ULencode -> Bool
$c> :: ULencode -> ULencode -> Bool
> :: ULencode -> ULencode -> Bool
$c>= :: ULencode -> ULencode -> Bool
>= :: ULencode -> ULencode -> Bool
$cmax :: ULencode -> ULencode -> ULencode
max :: ULencode -> ULencode -> ULencode
$cmin :: ULencode -> ULencode -> ULencode
min :: ULencode -> ULencode -> ULencode
Ord)

instance Show ULencode where
  show :: ULencode -> String
show ULencode
W = String
"(False, False)" -- Only working with .wav files.
  show ULencode
UL1 = String
"(False, True)" -- .ul appears.
  show ULencode
UL0 = String
"(True, False)" -- .ul disappears.
  show ULencode
_ = String
"(True, True)" -- .ul is constantly used.

class SoundFileExts a where
  getExts :: a -> (String,String)
  isFileExtsR :: a -> FilePath -> FilePath -> Bool
  isFileExtsR a
ul String
file1 String
file2 = String
xs String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
file1 Bool -> Bool -> Bool
&& String
ys String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
file2
    where (String
xs,String
ys) = a -> (String, String)
forall a. SoundFileExts a => a -> (String, String)
getExts a
ul

instance SoundFileExts ULencode where
  getExts :: ULencode -> (String, String)
getExts ULencode
W = (String
".wav",String
".wav")
  getExts ULencode
UL1 = (String
".wav",String
".ul")
  getExts ULencode
UL0 = (String
".ul",String
".wav")
  getExts ULencode
_ = (String
".ul",String
".ul")

-- | The variant of the 'soxOpG' that is used if the second file is not used (or in the situation where some
-- other file is used, too, e. g. with the .prof extension). For the functions in the module, this corresponds
-- to the \"-n\" second file argument.
soxOpG1 :: ULencode -> [String] -> FilePath -> [String] -> [String] -> IO (ExitCode, ByteString, ByteString)
soxOpG1 :: ULencode
-> [String]
-> String
-> [String]
-> [String]
-> IO (ExitCode, ByteString, ByteString)
soxOpG1 ULencode
ul [String]
xss String
file1 [String]
yss [String]
zss
 | ((String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (ULencode -> (String, String)) -> ULencode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ULencode -> (String, String)
forall a. SoundFileExts a => a -> (String, String)
getExts (ULencode -> String) -> ULencode -> String
forall a b. (a -> b) -> a -> b
$ ULencode
ul) String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
file1 =
    if ULencode
ul ULencode -> ULencode -> Bool
forall a. Ord a => a -> a -> Bool
< ULencode
UL0 then ProcessConfig () () () -> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (String -> [String] -> ProcessConfig () () ()
proc (String -> String
showE0Dup 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ [[String]
Item [[String]]
xss, [String
Item [String]
file1], [String]
Item [[String]]
yss, [String
Item [String]
"-n"], [String]
Item [[String]]
zss]))
    else ProcessConfig () () () -> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (String -> [String] -> ProcessConfig () () ()
proc (String -> String
showE0Dup 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ [[String]
Item [[String]]
xss, [String]
Item [[String]]
ulAccessParameters, [String
Item [String]
file1], [String]
Item [[String]]
yss, [String
Item [String]
"-n"], [String]
Item [[String]]
zss])) 
 | Bool
otherwise = String -> IO (ExitCode, ByteString, ByteString)
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.soxOpG1: A given file has inappropriate file extension, or there has occurred some other error. Please, check the arguments. "

-- | Function 'durationAG' returns a duration of the audio file in seconds.
durationAG :: ULencode -> FilePath -> IO Float
durationAG :: ULencode -> String -> IO Float
durationAG ULencode
ul String
file 
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
showE0Dup (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"soxi" = String -> IO Float
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.durationAG: The SoX executable is not properly installed."
  | Bool
otherwise = do
      (ExitCode
_, ByteString
hout) <- ProcessConfig () () () -> IO (ExitCode, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
readProcessStdout (String -> [String] -> ProcessConfig () () ()
proc (String -> String
showE0Dup String
"soxi") (if ULencode
ul ULencode -> ULencode -> Bool
forall a. Ord a => a -> a -> Bool
< ULencode
UL0 then [String
Item [String]
"-D",String
Item [String]
file] else [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat [[String
Item [String]
"-D"],[String]
Item [[String]]
ulAccessParameters,[String
Item [String]
file]]))
      let x0 :: String
x0 = (Char -> String -> String) -> String -> ByteString -> String
forall a. (Char -> a -> a) -> a -> ByteString -> a
foldr (:) [] ByteString
hout
      Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Float
forall a. Read a => String -> a
read String
x0::Float)

-- | A variant of the 'durationAG' with the first argument being 'W'.
durationA :: FilePath -> IO Float
durationA :: String -> IO Float
durationA = ULencode -> String -> IO Float
durationAG ULencode
W
{-# INLINE durationA #-}

-- | Function 'upperBndG' returns a maximum number of samples for use in other functions.
upperBndG :: ULencode -> FilePath -> IO Int
upperBndG :: ULencode -> String -> IO Int
upperBndG ULencode
ul String
file 
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
showE0Dup (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"soxi" = String -> IO Int
forall a. HasCallStack => String -> a
error String
"Composition.Sound.SoX.upperBndG: The SoX executable is not properly installed."
  | Bool
otherwise = do 
       (ExitCode
_, ByteString
hout) <- ProcessConfig () () () -> IO (ExitCode, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
readProcessStdout (String -> [String] -> ProcessConfig () () ()
proc (String -> String
showE0Dup String
"soxi") (if ULencode
ul ULencode -> ULencode -> Bool
forall a. Ord a => a -> a -> Bool
< ULencode
UL0 then [String
Item [String]
"-s",String
Item [String]
file] else [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat [[String
Item [String]
"-s"],[String]
Item [[String]]
ulAccessParameters,[String
Item [String]
file]])) 
       let x0 :: String
x0 = (Char -> String -> String) -> String -> ByteString -> String
forall a. (Char -> a -> a) -> a -> ByteString -> a
foldr (:) [] ByteString
hout
       Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int
forall a. Read a => String -> a
read String
x0::Int) 

-- | A variant of the 'selMaxAbsG' with the first argument being 'W'.
selMaxAbs :: FilePath -> (Int, Int) -> IO (ByteString, Bool)
selMaxAbs :: String -> (Int, Int) -> IO (ByteString, Bool)
selMaxAbs = ULencode -> String -> (Int, Int) -> IO (ByteString, Bool)
selMaxAbsG ULencode
W
{-# INLINE selMaxAbs #-}

-- | Function 'maxAbs' allows to choose a maximum by absolute value if the values are written as 'ByteString'. Bool 'True' corresponds to maximum value, 'False' - to minimum value
maxAbs :: (ByteString, ByteString) -> (ByteString, Bool)
maxAbs :: (ByteString, ByteString) -> (ByteString, Bool)
maxAbs ([], ByteString
_) = ([], Bool
False)
maxAbs (ByteString
_, []) = ([], Bool
False)
maxAbs (ByteString
xs, ByteString
ys) 
 | (Char -> Bool) -> ByteString -> ByteString
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')  ByteString
xs ByteString -> ByteString -> Bool
forall a. Ord a => a -> a -> Bool
> (Char -> Bool) -> ByteString -> ByteString
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') ByteString
ys = (ByteString
xs, Bool
True)
 | Bool
otherwise = (ByteString
ys, Bool
True)
{-# INLINE maxAbs #-}

ulAccessParameters :: [String]
ulAccessParameters :: [String]
ulAccessParameters = [String
Item [String]
"-r22050",String
Item [String]
"-c1"]
{-# INLINE ulAccessParameters #-}