-- |
-- Module      :  MMSyn7l
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- A program and a library to modify the amplitude of the sound representations for 
-- the Ukrainian language created by mmsyn7ukr package or somehow otherwise. Besides
-- it can be used to adjust volume for the sequential \"result*.wav\" files.
--

module MMSyn7l where

import qualified Data.List as L (sort,isPrefixOf,isSuffixOf)
import System.Directory
import Data.Char (toUpper, isDigit)
import qualified Sound.SoXBasics as SB
import qualified Sound.SoXBasics1 as SB1
import Data.Maybe (isJust)
import Control.Exception (onException)
import CaseBi.Arr (getBFstL')
import Sound.Control.Exception.FinalException
import System.Process
import System.Exit (ExitCode(ExitSuccess))
import EndOfExe (showE)
import Data.Maybe (fromJust)
import Numeric
import System.Info (os)

-- | Function 'changeVolume' is used to change the amplitude of the sound. 
-- For the proper proceeding you specify a @String@, which consists of 4 
-- digits (and it may be preceded by a symbol \"-\"). If the @String@ 
-- begins with the \"-\", then a sound amplitude decreases, otherwise 
-- the amplitude increases. The level of increase / decrease is 
-- determined by the magnitude of the absolute value of integer numbers. 
-- The greater is the number -- the greater is the amplitude change. 
-- The count begins with \"0000\" and ends with \"9999\" (the sign is not 
-- taken into consideration). If there is less than 4 digits in a @String@, 
-- then the @String@ is equivalent to that one with the appropriate number 
-- of zeroes preceding to fulfill to the 4 needed digits (for example, 
-- \"657\" is equivalent to \"0657\", \"-2\" is equivalent to \"-0002\" etc.) 
-- In such a case, for the @String@s without the 
-- initial sign \"-\" (the sound increases) an interval between the 
-- maximum by modulus value of the amlitude (which is represented by the 
-- parts of 1) and 1.0 is divided into 10 equal parts (starting a count 
-- from 0) and then that one of them is selected, which has a number 
-- determined by the first digit in the @String@ writing. Then (if specified 
-- further) the interval between this amplitude value and a value, 
-- which corresponds to the selection on the previous step the next 
-- first digit in the writing (for example, after \"4\" -- \"5\", 
-- after \"7\" -- \"8\" etc.), greater by 1 than the actually selected one, 
-- is also divided again into 10 equal parts and that one is selected, 
-- which corresponds to the number determined by the second digit in the 
-- String writing (again beginning with \"0\" and ending with \"9\") and so on 
-- until the 4th level. The greater exactness is not needed because our 
-- hearing ability hardly distinguish such a subtle sound changes. If 
-- the @String@ has as a first element the \'-\' @Char@ (the sound decreases), 
-- then everything is analogously the same, but an interval between the 
-- maximum by modulus amplitude value and 0.0 is divided into 10 equal parts 
-- and so on. 'Int' parameter is used to control the informational output
-- (to get it, specify 1). 
changeVolume ::  Int -> FilePath -> IO ()
changeVolume :: Int -> FilePath -> IO ()
changeVolume Int
n FilePath
file = do
  case (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
5 FilePath
os FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"mingw") of { Bool
True -> if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") then FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox"))
    [FilePath
file, FilePath
"-t", FilePath
"waveaudio", FilePath
"-d"] FilePath
"" IO (ExitCode, FilePath, FilePath) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled ; ~Bool
rrr -> if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"play") then FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"play")) [FilePath
file] FilePath
"" IO (ExitCode, FilePath, FilePath) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled } -- Is taken from the mmsyn7ukr package as playA.
  case Int
n of
   Int
1 -> do 
    let sound :: FilePath
sound = FilePath -> [(FilePath, FilePath)] -> FilePath -> FilePath
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' FilePath
"е" ([FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath
"A.wav", FilePath
"B.wav", FilePath
"C.wav", FilePath
"D.wav", FilePath
"E.wav", FilePath
"F.wav", FilePath
"G.wav", FilePath
"H.wav", 
         FilePath
"I.wav", FilePath
"J.wav", FilePath
"K.wav", FilePath
"L.wav", FilePath
"M.wav", FilePath
"N.wav", FilePath
"O.wav", FilePath
"P.wav", FilePath
"Q.wav", FilePath
"R.wav", 
          FilePath
"S.wav", FilePath
"T.wav", FilePath
"U.wav", FilePath
"V.wav", FilePath
"W.wav", FilePath
"X.wav", FilePath
"Y.wav", FilePath
"Z.wav", FilePath
"a.wav", FilePath
"b.wav", FilePath
"c.wav", 
            FilePath
"d.wav", FilePath
"e.wav", FilePath
"f.wav"] ([FilePath] -> [(FilePath, FilePath)])
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ [FilePath
"а",FilePath
"б",FilePath
"в",FilePath
"г",FilePath
"д",FilePath
"дж",FilePath
"дз", FilePath
"е",FilePath
"ж",FilePath
"з",FilePath
"и",FilePath
"й",FilePath
"к",FilePath
"л",FilePath
"м",FilePath
"н",FilePath
"о",FilePath
"п",FilePath
"р",
              FilePath
"с",FilePath
"сь",FilePath
"т",FilePath
"у",FilePath
"ф",FilePath
"х",FilePath
"ц",FilePath
"ць",FilePath
"ч",FilePath
"ш",FilePath
"ь",FilePath
"і",FilePath
"ґ"]) FilePath
file
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"You can now change the volume for the played sound representation for the Ukrainian sound " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper FilePath
sound)
    FilePath -> IO ()
putStrLn FilePath
""
    FilePath -> IO ()
putStr FilePath
"Please, specify the change by passing a String of digits (with may be a preceding symbol \'-\'). "
    FilePath -> IO ()
putStr FilePath
""
    FilePath -> IO ()
putStr FilePath
"For the proper proceeding you specify a String, which consists of 4 "
    FilePath -> IO ()
putStr FilePath
"digits (and it may be preceded by a symbol \"-\"). If the String "
    FilePath -> IO ()
putStr FilePath
"begins with the \"-\", then a sound amplitude decreases, otherwise "
    FilePath -> IO ()
putStr FilePath
"the amplitude increases. The level of increase / decrease is "
    FilePath -> IO ()
putStr FilePath
"determined by the magnitude of the absolute value of integer numbers. "
    FilePath -> IO ()
putStr FilePath
"The greater is the number -- the greater is the amplitude change. "
    FilePath -> IO ()
putStr FilePath
"The count begins with \"0000\" and ends with \"9999\" (the sign is not "
    FilePath -> IO ()
putStr FilePath
"taken into consideration). If there is less than 4 digits in a String, "
    FilePath -> IO ()
putStr FilePath
"then the String is equivalent to that one with the appropriate number "
    FilePath -> IO ()
putStr FilePath
"of zeroes preceding to fulfill to the 4 needed digits (for example, "
    FilePath -> IO ()
putStr FilePath
"\"657\" is equivalent to \"0657\", \"-2\" is equivalent to \"-0002\" etc.). "
    FilePath -> IO ()
putStr FilePath
"In such a case, for the Strings without the "
    FilePath -> IO ()
putStr FilePath
"initial sign \"-\" (the sound increases) an interval between the "
    FilePath -> IO ()
putStr FilePath
"maximum by modulus value of the amlitude (which is represented by the "
    FilePath -> IO ()
putStr FilePath
"parts of 1) and 1.0 is divided into 10 equal parts (starting a count "
    FilePath -> IO ()
putStr FilePath
"from 0) and then that one of them is selected, which has a number "
    FilePath -> IO ()
putStr FilePath
"determined by the first digit in the String writing. Then (if specified "
    FilePath -> IO ()
putStr FilePath
"further) the interval between this amplitude value and a value, "
    FilePath -> IO ()
putStr FilePath
"which corresponds to the selection on the previous step the next "
    FilePath -> IO ()
putStr FilePath
"first digit in the writing (for example, after \"4\" -- \"5\", "
    FilePath -> IO ()
putStr FilePath
"after \"7\" -- \"8\" etc.), greater by 1 than the actually selected one, "
    FilePath -> IO ()
putStr FilePath
"is also divided again into 10 equal parts and that one is selected, "
    FilePath -> IO ()
putStr FilePath
"which corresponds to the number determined by the second digit in the "
    FilePath -> IO ()
putStr FilePath
"String writing (again beginning with \"0\" and ending with \"9\") and so on "
    FilePath -> IO ()
putStr FilePath
"until the 4th level. The greater exactness is not needed because our "
    FilePath -> IO ()
putStr FilePath
"hearing ability hardly distinguish such a subtle sound changes. If "
    FilePath -> IO ()
putStr FilePath
"the String has as a first element the \'-\' Char (the sound decreases), "
    FilePath -> IO ()
putStr FilePath
"then everything is analogously the same, but an interval between the "
    FilePath -> IO ()
putStr FilePath
"maximum by modulus amplitude value and 0.0 is divided into 10 equal parts "
    FilePath -> IO ()
putStrLn FilePath
"and so on. "
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (FilePath -> IO ()
specifyVol FilePath
file) (do
      FilePath -> IO ()
putStrLn FilePath
""
      FilePath -> IO ()
putStrLn FilePath
"Something went wrong for the sound representation, please, check the input value and repeat once more! "
      FilePath -> IO ()
specifyVol FilePath
file)
   Int
_ -> IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (FilePath -> IO ()
specifyVol FilePath
file) (do
         FilePath -> IO ()
putStrLn FilePath
""
         FilePath -> IO ()
putStrLn FilePath
"Something went wrong for the sound representation, please, check the input value and repeat once more! "
         FilePath -> IO ()
specifyVol FilePath
file)

-- | Function 'specifyVol' is used internally in the 'changeVolume' to get the @String@ and to apply the needed change. 
specifyVol :: FilePath -> IO ()
specifyVol :: FilePath -> IO ()
specifyVol FilePath
file = do   
  FilePath
change0 <- IO FilePath
getLine
  Int
upperbound <- FilePath -> IO Int
SB.upperBnd FilePath
file
  (FilePath
originalStr, Bool
bool) <- FilePath -> (Int, Int) -> IO (FilePath, Bool)
SB.selMaxAbs FilePath
file (Int
0::Int, Int
upperbound)
  if Bool
bool 
    then FilePath -> (FilePath, FilePath) -> IO ()
changeVol3 FilePath
file (FilePath
change0, FilePath
originalStr)
    else FilePath -> (FilePath, FilePath) -> IO ()
changeVol4 FilePath
file (FilePath
change0, FilePath
originalStr)

-- | Function 'changeVol2' is used internally in the 'specifyVol' in case of decreasing of the sound.
changeVol2 :: FilePath -> String -> Float -> IO ()
changeVol2 :: FilePath -> FilePath -> Float -> IO ()
changeVol2 FilePath
file FilePath
xs Float
ampl = do 
  let ys :: FilePath
ys = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
4 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
xs
      coefA :: Float
coefA = Float
0.0001 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
ys::Int)
      ratio :: Float
ratio = Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
coefA
  FilePath -> Float -> IO ()
SB1.volS FilePath
file (Float
ratio Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ampl)
  
-- | Function 'changeVol3' is used internally in the 'specifyVol' in case of working with the maximum amplitude.
changeVol3 :: FilePath -> (String, String) -> IO ()
changeVol3 :: FilePath -> (FilePath, FilePath) -> IO ()
changeVol3 FilePath
file (FilePath
change0, FilePath
originalStr) = do
  let ampl :: Float
ampl = FilePath -> Float
forall a. Read a => FilePath -> a
read FilePath
originalStr::Float
  if Float
ampl Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.0 
    then do 
      let delta :: Float
delta = Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ampl
          xs :: FilePath
xs = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') FilePath
change0
      if Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
xs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"-" 
        then FilePath -> FilePath -> Float -> IO ()
changeVol2 FilePath
file FilePath
xs Float
ampl
        else do 
          let ys :: FilePath
ys = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
4 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Bool
isDigit) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
xs
              coefA :: Float
coefA = Float
0.0001 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
ys::Int)
              ratio :: Float
ratio = Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
delta Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
ampl) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
coefA
          FilePath -> Float -> IO ()
SB1.volS FilePath
file (Float
ratio Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ampl)
    else FinalException -> IO ()
catchEnd (FilePath -> FilePath -> FinalException
StrangeAnswer FilePath
"Sound.SoXBasics1" FilePath
"volS")

-- | Function 'changeVol4' is used internally in the 'specifyVol' in case of working with the minimum amplitude.
changeVol4 :: FilePath -> (String, String) -> IO ()
changeVol4 :: FilePath -> (FilePath, FilePath) -> IO ()
changeVol4 FilePath
file (FilePath
change0, FilePath
originalStr) = do
  let ampl :: Float
ampl = FilePath -> Float
forall a. Read a => FilePath -> a
read FilePath
originalStr::Float
  if Float
ampl Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.0
    then do 
      let delta :: Float
delta = (-Float
1.0) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ampl
          xs :: FilePath
xs = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') FilePath
change0
      if Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
xs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"-" 
        then FilePath -> FilePath -> Float -> IO ()
changeVol2 FilePath
file FilePath
xs Float
ampl
        else do 
          let ys :: FilePath
ys = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
4 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
xs
              coefA :: Float
coefA = Float
0.0001 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
ys::Int)
              ratio :: Float
ratio = Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
delta Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
ampl) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
coefA
          FilePath -> Float -> IO ()
SB1.volS FilePath
file (Float
ratio Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ampl)
    else FinalException -> IO ()
catchEnd (FilePath -> FilePath -> FinalException
StrangeAnswer FilePath
"Sound.SoXBasics1" FilePath
"volS")

-- | Works with the \"result*.wav\" files in the current directory: it adjusts volume levels for the sequence of them starting from the 
-- first argument in a list and ending with the second one (if specified). If there is no first -- all such files are adjusted; if there is no second one -- 
-- the files are adjusted to the last one. Count starts at 0. 
adjustVolRes :: [String] -> IO ()
adjustVolRes :: [FilePath] -> IO ()
adjustVolRes [FilePath]
args = do
  [FilePath]
dir <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
  let dirV0 :: [FilePath]
dirV0 = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
L.sort ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf FilePath
"result") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
dir
      first0 :: FilePath
first0 = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
1 ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
args
      last0 :: FilePath
last0  = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
1 ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
1 ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
args
      idxAllN :: Int
idxAllN = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
dirV0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  IO () -> IO Any -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do { 
    let first1 :: Int
first1 = FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
first0::Int
        last1 :: Int
last1 = FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
last0::Int
        first2 :: Int
first2 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int
forall a. Num a => a -> a
abs Int
first1) (Int -> Int
forall a. Num a => a -> a
abs Int
last1)
        last2 :: Int
last2 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int
forall a. Num a => a -> a
abs Int
first1) (Int -> Int
forall a. Num a => a -> a
abs Int
last1)
        first :: Int
first
         | Int
first2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
idxAllN = Int
0
         | Bool
otherwise = Int
first2
        l :: Int
l =  if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
last2 Int
idxAllN Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Int
idxAllN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
first Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
last2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
first Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     ; (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> FilePath -> IO ()
changeVolume Int
1) ([FilePath] -> IO ())
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
l ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
first ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath]
dirV0
     ; FilePath -> IO ()
putStrLn FilePath
""
     ; FilePath -> IO ()
putStrLn FilePath
"Now you have changed (or left unchanged) the amplitudes for the needed \"result*.wav\" sound files." }) (do
         FilePath -> IO Any
forall a. HasCallStack => FilePath -> a
error FilePath
"Please, specify a right numbers for the first and last files to be adjusted starting count from 0.")

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

-- Taken from the DobutokO.Sound.IntermediateF module here so that they are more used this way.  

-- | Takes a filename to be applied a SoX chain of effects (or just one) 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 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.
soxE :: FilePath -> [String] -> IO ()
soxE :: FilePath -> [FilePath] -> IO ()
soxE FilePath
file [FilePath]
arggs = do
  (ExitCode
code,FilePath
_,FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) ([FilePath
file,FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"effects" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
efw2 FilePath
file] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
arggs) FilePath
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> FilePath -> FilePath -> IO ()
renameFile (FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"effects" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
efw2 FilePath
file) FilePath
file
    ExitCode
_ -> do
       FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"effects" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
efw2 FilePath
file
       FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"MMSyn7l.soxE \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\" has not been successful. The file has not been changed at all. "

-- | 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 :: FilePath -> IO ()
fadeEnds = Int -> FilePath -> IO ()
fadeEndsMilN Int
10

-- | 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 in 5 times 
-- smaller than for 'fadeEnds' function and is equal to 0.002 sec. For more information, please, refer to the SoX documentation.
fadeEndsMil2 :: FilePath -> IO ()
fadeEndsMil2 :: FilePath -> IO ()
fadeEndsMil2 = Int -> FilePath -> IO ()
fadeEndsMilN Int
2

-- | 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 -> FilePath -> IO ()
fadeEndsMilN Int
n FilePath
file = FilePath -> [FilePath] -> IO ()
soxE FilePath
file [FilePath
"fade",FilePath
"q", Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
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) FilePath
"",FilePath
"-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 -> FilePath -> IO ()
fadeEndsTMN Char
c Float
per1 Float
per2 FilePath
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 <- FilePath -> IO Float
SB.durationA FilePath
file
    FilePath -> [FilePath] -> IO ()
soxE FilePath
file [FilePath
"fade", FilePath -> [(Char, FilePath)] -> Char -> FilePath
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' FilePath
"l" [(Char
'h',FilePath
"h"),(Char
'p',FilePath
"p"),(Char
'q',FilePath
"q"),(Char
't',FilePath
"t")] Char
c, Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
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) FilePath
"",FilePath
"-0.0", 
      Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
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) FilePath
""]
 | Bool
otherwise = FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"MMSyn7l.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 -> FilePath -> IO ()
fadeEndsTMB Char
c Float
per 
 | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
per 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
per Float
50 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = Char -> Float -> Float -> FilePath -> IO ()
fadeEndsTMN Char
c Float
per Float
per
 | Bool
otherwise = FilePath -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"MMSyn7l.fadeEndsTMB: the percentage is out of the (0..50] range. "

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

-- New functions with usage of the moved here fadeEnds* and 'soxE' functions.

-- | Using a new function 'fadeEndsMil2' fades the ends of the .wav files in the current directory.
fadeWav002 :: IO ()
fadeWav002 :: IO ()
fadeWav002 = do
  [FilePath]
dir0 <- ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` FilePath
".wav")) (IO [FilePath] -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
listDirectory (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
"."
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
fadeEndsMil2 [FilePath]
dir0

-- | Using a new function 'fadeEndsMilN' fades the ends of the .wav files in the current directory. The first argument is the 'Int' argument 
-- for the 'fadeEndsMilN' and is a number of milliseconds to be used for fading (usually from 1 to 10). 
fadeWavN :: Int -> IO ()
fadeWavN :: Int -> IO ()
fadeWavN Int
n = do
  [FilePath]
dir0 <- ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` FilePath
".wav")) (IO [FilePath] -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
listDirectory (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
"."
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> FilePath -> IO ()
fadeEndsMilN Int
n) [FilePath]
dir0        

-- | Converts WAV file to FLAC file using SoX (please, check before whether your installation supports FLAC files) using possible rate and bit depth
-- conversion accordingly to 'soxBasicParams' format. If the conversion is successful ('ExitCode' is 'ExitSuccess') then removes the primary file.
wavToFlac :: String -> FilePath -> IO ()
wavToFlac :: FilePath -> FilePath -> IO ()
wavToFlac FilePath
ys FilePath
file = do
  let (FilePath
ts,FilePath
zs) = Int -> FilePath -> (FilePath, FilePath)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 (FilePath -> (FilePath, FilePath))
-> (FilePath -> FilePath) -> FilePath -> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
init (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
ys
  (ExitCode
code,FilePath
_,FilePath
herr) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file,FilePath -> [(FilePath, FilePath)] -> FilePath -> FilePath
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' FilePath
"-r22050" ([FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath
"11",FilePath
"16", FilePath
"17", FilePath
"19", FilePath
"32", FilePath
"44", FilePath
"48",
     FilePath
"80", FilePath
"96"] [FilePath
"-r11025",FilePath
"-r16000",FilePath
"-r176400",FilePath
"-r192000",FilePath
"-r32000",FilePath
"-r44100",FilePath
"-r48000",FilePath
"-r8000",FilePath
"-r96000"]) FilePath
ts, if FilePath
zs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"2" then FilePath
"-b24"
       else FilePath
"-b16",Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"flac"] FilePath
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> FilePath -> IO ()
removeFile FilePath
file
    ExitCode
_           -> do
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"MMSyn7l.wavToFlac: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
herr
      Bool
exi <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"flac"
      if Bool
exi then FilePath -> IO ()
removeFile (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"flac") IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
""
      else FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
""

-- | Converts FLAC file to WAV file using SoX (please, check before whether your installation supports FLAC files) using possible rate and bit depth
-- conversion accordingly to 'soxBasicParams' format. If the conversion is successful ('ExitCode' is 'ExitSuccess') then removes the primary file.
flacToWav :: String -> FilePath -> IO ()
flacToWav :: FilePath -> FilePath -> IO ()
flacToWav FilePath
ys FilePath
file = do
  let (FilePath
ts,FilePath
zs) = Int -> FilePath -> (FilePath, FilePath)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 (FilePath -> (FilePath, FilePath))
-> (FilePath -> FilePath) -> FilePath -> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
init (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
ys
  (ExitCode
code,FilePath
_,FilePath
herr) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file,FilePath -> [(FilePath, FilePath)] -> FilePath -> FilePath
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' FilePath
"-r22050" ([FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath
"11",FilePath
"16", FilePath
"17", FilePath
"19", FilePath
"32", FilePath
"44", FilePath
"48",
     FilePath
"80", FilePath
"96"] [FilePath
"-r11025",FilePath
"-r16000",FilePath
"-r176400",FilePath
"-r192000",FilePath
"-r32000",FilePath
"-r44100",FilePath
"-r48000",FilePath
"-r8000",FilePath
"-r96000"]) FilePath
ts, if FilePath
zs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"2" then FilePath
"-b24"
       else FilePath
"-b16",Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"wav"] FilePath
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> FilePath -> IO ()
removeFile FilePath
file
    ExitCode
_           -> do
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"MMSyn7l.flacToWav: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
herr
      Bool
exi <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"wav"
      if Bool
exi then FilePath -> IO ()
removeFile (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"wav") IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
""
      else FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
""      

w2f :: FilePath -> FilePath
w2f :: FilePath -> FilePath
w2f FilePath
file = let (FilePath
zs,FilePath
ts) = Int -> FilePath -> (FilePath, FilePath)
forall a. Int -> [a] -> ([a], [a])
splitAt (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) FilePath
file in if FilePath
ts FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".wav" then FilePath
zs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".flac" else FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"You give not a WAV file! "
     
f2w :: FilePath -> FilePath
f2w :: FilePath -> FilePath
f2w FilePath
file = let (FilePath
zs,FilePath
ts) = Int -> FilePath -> (FilePath, FilePath)
forall a. Int -> [a] -> ([a], [a])
splitAt (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) FilePath
file in if FilePath
ts FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".flac" then FilePath
zs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".wav" else FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"You give not a FLAC file! "

wOrf :: FilePath -> String
wOrf :: FilePath -> FilePath
wOrf FilePath
file = let us :: FilePath
us = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) FilePath
file in case FilePath
us of { FilePath
".wav" -> FilePath
"w" ; FilePath
"flac" -> FilePath
"f" ;
  ~FilePath
bbb -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"You give neither a WAV nor a FLAC file! " }

cfw2wf :: FilePath -> FilePath
cfw2wf :: FilePath -> FilePath
cfw2wf FilePath
file
 | FilePath -> FilePath
wOrf FilePath
file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"w" = FilePath -> FilePath
w2f FilePath
file
 | FilePath -> FilePath
wOrf FilePath
file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"f" = FilePath -> FilePath
f2w FilePath
file
 | Bool
otherwise = FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"You give neither a WAV nor a FLAC file! "

efw2 :: FilePath -> String
efw2 :: FilePath -> FilePath
efw2 FilePath
file = let us :: FilePath
us = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) FilePath
file in case FilePath
us of { FilePath
".wav" -> FilePath
".wav" ; FilePath
"flac" -> FilePath
".flac" ;
  ~FilePath
bbb -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"You give neither a WAV nor a FLAC file! " }

efw2vv :: FilePath -> String
efw2vv :: FilePath -> FilePath
efw2vv FilePath
file = let us :: FilePath
us = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) FilePath
file in case FilePath
us of { FilePath
".wav" -> FilePath
".flac" ; FilePath
"flac" -> FilePath
".wav" ;
  ~FilePath
bbb -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"You give neither a WAV nor a FLAC file! " }