word-note-sox (empty) → 0.1.0.0

raw patch · 5 files changed

+355/−0 lines, 5 filesdep +basedep +bytestringdep +directory

Dependencies added: base, bytestring, directory, end-of-exe, monoid-insertleft, typed-process

Files

• CHANGELOG.md +6/−0
• Composition/Sound/SoX.hs +243/−0
• LICENSE +20/−0
• README.md +18/−0
• word-note-sox.cabal +68/−0

@@ -0,0 +1,6 @@+# Revision history for word-note-sox++## 0.1.0.0 -- 2024-02-06++* First version. Released on an unsuspecting world.+

@@ -0,0 +1,243 @@+-- |+-- 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 file arggs = do+  let effile = file ++ "effects" ++ efw2 file+  (code,_,herr) <- readProcess (proc (showE0Dup "sox") ([file,effile] ++ arggs))+  case code of+    ExitSuccess -> renameFile effile file+    _ -> do+       exist <- doesFileExist effile+       if exist then do +                  hPut stderr herr+                  removeFile effile+                  putStrLn $ "Composition.Sound.SoX.soxE: Applying SoX on the file \"" ++ file ++ "\" has not been successful. The file " ++ file ++ " has not been changed at all. "+       else do+         hPut stderr herr+         putStrLn $ "Composition.Sound.SoX.soxE: Creation of the file \"" ++ effile ++ "\" has not been successful. The file " ++ file ++ " has not been changed at all. "++w2f :: FilePath -> FilePath+w2f file +  | ts == ".wav" = zs ++ ".flac" +  | otherwise = error "Composition.Sound.SoX.w2f: The file is not a WAV file! "+      where (zs,ts) = splitAtEndG 4 file  +{-# INLINE w2f #-}++f2w :: FilePath -> FilePath+f2w file +  | ts == ".flac" = zs ++ ".wav" +  | otherwise = error "Composition.Sound.SoX.f2w: The file is not a FLAC file! "+      where (zs,ts) = splitAtEndG 5 file+{-# INLINE f2w #-}++wOrf :: FilePath -> String+wOrf file +  | us == ".wav" = "w"+  | us == "flac" = "f"+  | otherwise = error "Composition.Sound.SoX.wOrf: The file is neither a WAV nor a FLAC file!"+      where us = takeFromEndG 4 file +{-# INLINE wOrf #-}++cfw2wf :: FilePath -> FilePath+cfw2wf file+ | wf == "w" = w2f file+ | wf == "f" = f2w file+ | otherwise = error "Composition.Sound.SoX.cfw2wf: The file is neither a WAV nor a FLAC file! "+     where wf = wOrf file+{-# INLINE cfw2wf #-}++efw2 :: FilePath -> String+efw2 file + | us == ".wav" = us+ | us == "flac" = '.':us+ | otherwise = error "Composition.Sound.SoX.efw2: The file is neither a WAV nor a FLAC file!"+     where us = takeFromEndG 4 file+{-# INLINE efw2 #-}++efw2vv :: FilePath -> String+efw2vv file + | us == ".wav" = ".flac"+ | us == "flac" = ".wav"+ | otherwise = error "Composition.Sound.SoX.efw2vv: The file is neither a WAV nor a FLAC file! "+     where us = takeFromEndG 4 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 = fadeEndsMilN 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 n file = soxE file ["fade","q", showFFloat (Just 4) (if (n `rem` 11) /= 0 then 0.001 * fromIntegral (n `rem` 11) else 0.002) "","-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 c per1 per2 file + | compare per1 0 == GT && compare per2 0 == GT && compare (per1 + per2) 100 /= GT = do+    d0 <- durationA file+    soxE file ["fade", case c of {'h' -> "h"; 'p' -> "p"; 'q' -> "q"; 't' -> "t"; ~_ -> "l"}, showFFloat (Just 4) (d0 * per1 / 100.0) "","-0.0", +      showFFloat (Just 4) (d0 * per2 / 100.0) ""]+ | otherwise = error "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 c per + | per > 0 && per <= 50 = fadeEndsTMN c per per+ | otherwise = error "Composition.Sound.SoX.fadeEndsTMB: The percentage is out of the (0..50] range. "+{-# INLINE fadeEndsTMB #-}++----------------------------------+--++takeU :: ByteString -> ByteString+takeU u+ | take 1 u == "-" = take 9 u+ | otherwise = take 8 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 ul file (lowerbound, upperbound) +  | null . showE0Dup $ "sox" =   error "Composition.Sound.SoX.getMinAG: The SoX executable is not properly installed."+  | otherwise = do+     (_, _, herr) <- soxOpG1 ul [] file [] ["trim", show lowerbound ++ "s", "=" ++ show upperbound ++ "s", "stat"]+     let zs = lines herr +     return (let u = (words $ zs !! 3) !! 2 in takeU 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 ul file (lowerbound, upperbound) +  | null . showE0Dup $ "sox" = error "Composition.Sound.SoX.getMinAG: The SoX executable is not properly installed."+  | otherwise = do+      (_, _, herr1) <- soxOpG1 ul [] file [] ["trim", show lowerbound ++ "s", "=" ++ show upperbound ++ "s", "stat"]+      let zs = lines herr1+      return (let u = (words $ zs !! 4) !! 2 in takeU 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 ul file (lowerbnd, upperbnd) = do+  tX <- getMaxAG ul file (lowerbnd, upperbnd)+  tN <- getMinAG ul file (lowerbnd, upperbnd)+  return (maxAbs (tX, tN))++data ULencode = W | UL1 | UL0 | UL deriving (Eq, Ord)++instance Show ULencode where+  show W = "(False, False)" -- Only working with .wav files.+  show UL1 = "(False, True)" -- .ul appears.+  show UL0 = "(True, False)" -- .ul disappears.+  show _ = "(True, True)" -- .ul is constantly used.++class SoundFileExts a where+  getExts :: a -> (String,String)+  isFileExtsR :: a -> FilePath -> FilePath -> Bool+  isFileExtsR ul file1 file2 = xs `isSuffixOf` file1 && ys `isSuffixOf` file2+    where (xs,ys) = getExts ul++instance SoundFileExts ULencode where+  getExts W = (".wav",".wav")+  getExts UL1 = (".wav",".ul")+  getExts UL0 = (".ul",".wav")+  getExts _ = (".ul",".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 ul xss file1 yss zss+ | (fst . getExts $ ul) `isSuffixOf` file1 =+    if ul < UL0 then readProcess (proc (showE0Dup "sox") (filter (not . null) . mconcat $ [xss, [file1], yss, ["-n"], zss]))+    else readProcess (proc (showE0Dup "sox") (filter (not . null) . mconcat $ [xss, ulAccessParameters, [file1], yss, ["-n"], zss])) + | otherwise = error "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 ul file +  | null . showE0Dup $ "soxi" = error "Composition.Sound.SoX.durationAG: The SoX executable is not properly installed."+  | otherwise = do+      (_, hout) <- readProcessStdout (proc (showE0Dup "soxi") (if ul < UL0 then ["-D",file] else mconcat [["-D"],ulAccessParameters,[file]]))+      let x0 = foldr (:) [] hout+      return (read x0::Float)++-- | A variant of the 'durationAG' with the first argument being 'W'.+durationA :: FilePath -> IO Float+durationA = durationAG W+{-# INLINE durationA #-}++-- | Function 'upperBndG' returns a maximum number of samples for use in other functions.+upperBndG :: ULencode -> FilePath -> IO Int+upperBndG ul file +  | null . showE0Dup $ "soxi" = error "Composition.Sound.SoX.upperBndG: The SoX executable is not properly installed."+  | otherwise = do +       (_, hout) <- readProcessStdout (proc (showE0Dup "soxi") (if ul < UL0 then ["-s",file] else mconcat [["-s"],ulAccessParameters,[file]])) +       let x0 = foldr (:) [] hout+       return (read x0::Int) ++-- | A variant of the 'selMaxAbsG' with the first argument being 'W'.+selMaxAbs :: FilePath -> (Int, Int) -> IO (ByteString, Bool)+selMaxAbs = selMaxAbsG 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 ([], _) = ([], False)+maxAbs (_, []) = ([], False)+maxAbs (xs, ys) + | dropWhile (== '-')  xs > dropWhile (== '-') ys = (xs, True)+ | otherwise = (ys, True)+{-# INLINE maxAbs #-}++ulAccessParameters :: [String]+ulAccessParameters = ["-r22050","-c1"]+{-# INLINE ulAccessParameters #-}+

@@ -0,0 +1,20 @@+Copyright (c) 2019-2024 Oleksandr Zhabenko++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,18 @@+ Devotion+ ========++The author would like to devote this project to support the Foundation GASTROSTARS.++Besides, you can support Ukrainian people.++All support is welcome, including donations for the needs of the Ukrainian army, IDPs and refugees.++If you would like to share some financial support, please, contact the mentioned foundation+using the URL:++[Contact Foundation GASTROSTARS](https://gastrostars.nl/hou-mij-op-de-hoogte)++or ++[Donation Page](https://gastrostars.nl/doneren)+

@@ -0,0 +1,68 @@+cabal-version:      3.0++-- The name of the package.+name:               word-note-sox++-- The package version.+version:            0.1.0.0++-- A short (one-line) description of the package.+synopsis:+    SoX for algorithmic composition with groups of notes liken to words++-- A longer description of the package.+description:        A basic SoX functionality for the new project related to music and algorithmic composition. Is rewritten from algorithmic-composition-basic functionality and some other ones.++-- URL for the project homepage or repository.+homepage:+    https://hackage.haskell.org/package/word-note-sox++bug-reports:        https://github.com/Oleksandr-Zhabenko/word-note-sox/issues++-- The license under which the package is released.+license:            MIT++-- The file containing the license text.+license-file:       LICENSE++-- The package author(s).+author:             Oleksandr Zhabenko++-- An email address to which users can send suggestions, bug reports, and patches.+maintainer:         oleksandr.zhabenko@yahoo.com++-- A copyright notice.+copyright:          Oleksandr Zhabenko+category:           Sound, Language+build-type:         Simple++-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files:    CHANGELOG.md, README.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:++common warnings+    ghc-options: -Wall++library+    -- Import common warning flags.+    import:           warnings++    -- Modules exported by the library.+    exposed-modules:  Composition.Sound.SoX++    -- Modules included in this library but not exported.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    other-extensions: NoImplicitPrelude, OverloadedStrings, OverloadedLists++    -- Other library packages from which modules are imported.+    build-depends:    base >=4.13 && < 5, typed-process >= 0.2.6.1 && <1, bytestring >= 0.10.8.0 && <1, directory >=1.3.4.0 && <2, end-of-exe ==0.1.2.0, monoid-insertleft ==0.1.0.1++    -- Directories containing source files.+    hs-source-dirs:   .++    -- Base language which the package is written in.+    default-language: Haskell2010