packages feed

sox 0.0.1 → 0.2.3.2

raw patch · 15 files changed

Files

sox.cabal view
@@ -1,11 +1,11 @@+Cabal-Version:    2.2 Name:             sox-Version:          0.0.1-License:          GPL+Version:          0.2.3.2+License:          GPL-3.0-only License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de> Maintainer:       Henning Thielemann <haskell@henning-thielemann.de> Homepage:         http://www.haskell.org/haskellwiki/Sox-Package-URL:      http://code.haskell.org/~thielema/sox/ Category:         Sound Synopsis:         Play, write, read, convert audio signals using Sox Description:@@ -19,44 +19,44 @@    and in the path to the executables must be set.    .    In the past this was part of the synthesizer package.-   .-   There is some ancient code,-   which allows interactive playback using the shell-pipe package on GHC-6.2,-   where no runInteractiveProcess was available.-Tested-With:       GHC==6.8.2-Cabal-Version:     >=1.2+Tested-With:       GHC==6.8.2, GHC==6.10.4, GHC==6.12.1+Tested-With:       GHC==7.0.4, GHC==7.2.1, GHC==7.4.2, GHC==7.6.1 Build-Type:        Simple Extra-Source-Files:   Makefile   unix/src/Sound/Sox/System.hs   windows/src/Sound/Sox/System.hs -Flag splitBase-  description: Choose the new smaller, split-up base package.+Source-Repository this+  Tag:         0.2.3.2+  Type:        darcs+  Location:    https://hub.darcs.net/thielema/sox/ -Flag executeShell-  description: use ShellPipe package instead of process, preserved for historical reasons-  default:     False+Source-Repository head+  Type:        darcs+  Location:    https://hub.darcs.net/thielema/sox/  Library   Build-Depends:-    explicit-exception >= 0.1.3 && < 0.2,-    transformers >= 0.0.1 && <0.2-  If flag(splitBase)-    Build-Depends:-      base >= 2 && <4,-      process >= 1.0 && < 1.1,-      containers >= 0.1 && <0.3-  Else-    Build-Depends: base >= 1.0 && < 2+    sample-frame >= 0.0.1 && <0.1,+    explicit-exception >= 0.1.3 && < 0.3,+    -- that's the way to get compatibility between GHC 6.10 and 6.12+    extensible-exceptions >=0.1.1 && <0.2,+    transformers >=0.2 && <0.7,+    semigroups >=0.1 && <1.0,+    utility-ht >=0.0.5 && <0.1,+    process >=1.0 && <1.7,+    containers >=0.1 && <0.7,+    base >=2 && <5    Hs-Source-Dirs: src   If os(windows)     Hs-Source-Dirs: windows/src   Else     Hs-Source-Dirs: unix/src-    Build-Depends: unix >=2.3 && <2.4+    Build-Depends: unix >=2.3 && <2.9 +  Default-Language: Haskell98   GHC-Options: -Wall    Exposed-Modules:@@ -69,10 +69,10 @@     Sound.Sox.Frame     Sound.Sox.Frame.Stereo     Sound.Sox.Signal.List+    Sound.Sox.Information   Other-Modules:     Sound.Sox.Private.Option     Sound.Sox.Private.Arguments     Sound.Sox.Private.Format---    Sound.Sox.Private.Information-    Sound.Sox.StorableUtility+    Sound.Sox.Private.Information     Sound.Sox.System
src/Sound/Sox/Convert.hs view
@@ -4,7 +4,7 @@ import qualified Sound.Sox.Private.Arguments as Args import Data.Monoid (mconcat, ) -import qualified System.Cmd as Cmd+import qualified System.Process as Cmd -- import qualified System.IO as IO import System.Exit (ExitCode, ) @@ -13,7 +13,7 @@ {- | > :load Sound.Sox.Convert >-> generic Option.none "test.aiff" Option.none "test.wav"+> simple Option.none "test.aiff" Option.none "test.wav" -} simple ::    Option.T {- ^ source options -} ->
src/Sound/Sox/Format.hs view
@@ -24,15 +24,22 @@ iff8svx :: T iff8svx = custom "8svx" +muLaw :: T+muLaw = custom "ul" + signedByte, unsignedByte :: T-signedByte   = custom "sb"-unsignedByte = custom "ub"+signedByte   = custom "s8"+unsignedByte = custom "u8"  signedWord, unsignedWord :: T-signedWord   = custom "sw"-unsignedWord = custom "uw"+signedWord   = custom "s16"+unsignedWord = custom "u16" -signedLong {-, unsignedLong-} :: T-signedLong   = custom "sl"--- unsignedLong = custom "ul"+signedLong, unsignedLong :: T+signedLong   = custom "s32"+unsignedLong = custom "u32"++ieeeSinglePrecision, ieeeDoublePrecision :: T+ieeeSinglePrecision = custom "f32"+ieeeDoublePrecision = custom "f64"
src/Sound/Sox/Frame.hs view
@@ -1,42 +1,58 @@-module Sound.Sox.Frame where+module Sound.Sox.Frame (C(..), Frame.withSignal, Frame.numberOfChannels, ) where +import qualified Sound.Frame as Frame+import qualified Sound.Frame.Stereo as Stereo+import qualified Sound.Frame.MuLaw  as MuLaw+ import qualified Sound.Sox.Format as Format -import Data.Word (Word8, Word16, )+import Data.Word (Word8, Word16, Word32, ) import Data.Int (Int8, Int16, Int32, )  -class C y where-   {- | The argument is not touched and can be undefined -}-   numberOfChannels :: y -> Int+class Frame.C y => C y where    format :: y -> Format.T + instance C Word8 where-   numberOfChannels _ = 1    format _ = Format.unsignedByte  instance C Int8 where-   numberOfChannels _ = 1    format _ = Format.signedByte  instance C Word16 where-   numberOfChannels _ = 1    format _ = Format.unsignedWord  instance C Int16 where-   numberOfChannels _ = 1    format _ = Format.signedWord -{- instance C Word32 where-   numberOfChannels _ = 1    format _ = Format.unsignedLong--}  instance C Int32 where-   numberOfChannels _ = 1    format _ = Format.signedLong +{- |+The floating point instances are dangerous,+because Storable Float may not use IEEE format+that sox uses according to its man page.+This is strange since sox uses the host's endianess for multi-byte values.+So, why does it not use the machine's floating point format?+-}+instance C Float where+   format _ = Format.ieeeSinglePrecision -withSignal :: (y -> a) -> (sig y -> a)-withSignal f _ = f undefined+instance C Double where+   format _ = Format.ieeeDoublePrecision++instance C MuLaw.T where+   format _ = Format.muLaw++{-+Shall we add instances for Float and Double?+Sox requires floating point numbers in IEEE formats,+but we cannot warrant that the Storable instances uses those formats.+-}++instance C a => C (Stereo.T a) where+   format y = format (Stereo.left y)
src/Sound/Sox/Frame/Stereo.hs view
@@ -1,42 +1,6 @@-{--This data type can be used as sample type for stereo signals.+{- |+We just re-export the type from sample-frame:Sound.Frame.Stereo. -} module Sound.Sox.Frame.Stereo (T, left, right, cons, ) where -import qualified Sound.Sox.Frame as Frame--import Control.Monad (liftM2, )--import Foreign.Storable (Storable (..), )-import qualified Sound.Sox.StorableUtility as Store---data T a = Cons {left, right :: !a}---{-# INLINE cons #-}-cons :: a -> a -> T a-cons = Cons--instance Functor T where-   {-# INLINE fmap #-}-   fmap f (Cons l r) = Cons (f l) (f r)----- cf. StorableInstances-instance (Storable a) => Storable (T a) where-   sizeOf y = Store.sizeOfArray 2 $ left y-   alignment y = alignment $ left y-   peek ptr =-      Store.run ptr $-         liftM2 Cons-            Store.peekNext-            Store.peekNext-   poke ptr (Cons l r) =-      Store.run ptr $-         do Store.pokeNext l-            Store.pokeNext r--instance Frame.C a => Frame.C (T a) where-   numberOfChannels y = 2 * Frame.numberOfChannels (left y)-   format y = Frame.format (left y)+import Sound.Frame.Stereo
+ src/Sound/Sox/Information.hs view
@@ -0,0 +1,97 @@+{- |+This module calls the 'soxi' command+which is available since 'sox' version 14.++We have to call 'soxi' for every option.+However we hide this in our interface,+such that we could do more efficiently,+if 'soxi' supports multiple outputs in future.+-}+module Sound.Sox.Information (+   T(Cons),+   simple,+   format,+   sampleRate,+   numberOfChannels,+   length,+   bitsPerSample,+   get,+   exampleMulti,+   exampleSingle,+   ) where++import qualified Control.Monad.Trans.Reader as MR+import Control.Applicative (Applicative, pure, liftA3, (<*>), )+import Data.String.HT (trim, )+import Text.Read.HT (maybeRead, )++import qualified System.Process as Proc+import qualified System.IO as IO+import Control.Exception (bracket, )+-- import System.IO.Error (ioError, userError, )+-- import System.Exit (ExitCode, )++import Prelude hiding (length, )+++newtype T a =+   Cons (MR.ReaderT FilePath IO a)++instance Functor T where+   {-# INLINE fmap #-}+   fmap f (Cons m) = Cons (fmap f m)++instance Applicative T where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure = Cons . pure+   (Cons f) <*> (Cons x) = Cons (f <*> x)+++simple :: Read a => (String -> Maybe a) -> String -> T a+simple rd option =+   Cons $ MR.ReaderT $ \fileName ->+      bracket+         (Proc.runInteractiveProcess "soxi"+             (option : fileName : [])+             Nothing Nothing)+         (\(input,output,err,proc) ->+             mapM_ IO.hClose [input, output, err] >>+             Proc.terminateProcess proc)+         (\(_,output,_,_) ->+            maybe+               (ioError (userError "soxi returned rubbish"))+               return .+            rd =<<+            IO.hGetContents output)++format :: T String+format = simple Just "-t"++simpleRead :: String -> T Int+simpleRead = simple (maybeRead . trim)++sampleRate :: T Int+sampleRate = simpleRead "-r"++numberOfChannels :: T Int+numberOfChannels = simpleRead "-c"++length :: T Int+length = simpleRead "-s"++bitsPerSample :: T Int+bitsPerSample = simpleRead "-b"++++get :: T a -> FilePath -> IO a+get (Cons act) = MR.runReaderT act++exampleMulti :: IO (String, Int, Int)+exampleMulti =+   get (liftA3 (,,) format sampleRate bitsPerSample) "test.aiff"++exampleSingle :: IO Int+exampleSingle =+   get sampleRate "test.aiff"
src/Sound/Sox/Option/Format.hs view
@@ -26,6 +26,10 @@ sampleRate r =    single "-r" [show r] +bitsPerSample :: Int -> T+bitsPerSample b =+   single "-b" [show b]+ format :: Format.T -> T format fmt =    single "-t" [Format.decons fmt]
src/Sound/Sox/Play.hs view
@@ -18,7 +18,7 @@ {- | > :load Sound.Sox.Play Sound.Sox.Signal.List >-> generic Sound.Sox.Signal.List.put Option.none 11025 (iterate (1000+) (0::Data.Int.Int16))+> simple Sound.Sox.Signal.List.put Option.none 11025 (iterate (1000+) (0::Data.Int.Int16)) -} simple ::    (Frame.C y) =>@@ -50,7 +50,12 @@    IO ExitCode extended write srcOpts dstOpts sampleRate stream =    bracket-      (Proc.runInteractiveProcess "play"+      {-+      Formerly we called 'play' here.+      On Windows the SoX package does not install a 'play' command.+      However using the '-d' argument for the destination always works.+      -}+      (Proc.runInteractiveProcess "sox"           (Args.decons $ mconcat $            OptPriv.toArguments              (mconcat $@@ -62,6 +67,7 @@               []) :            Args.pipe :            OptPriv.toArguments dstOpts :+           Args.single "-d" :            [])           Nothing Nothing)       (\(input,output,err,_proc) ->
src/Sound/Sox/Private/Arguments.hs view
@@ -1,12 +1,16 @@ module Sound.Sox.Private.Arguments where -import Data.Monoid (Monoid(..), )+import Data.Monoid (Monoid(mempty, mappend), )+import Data.Semigroup (Semigroup((<>)), )  newtype T = Cons {decons :: [String]} +instance Semigroup T where+   Cons x <> Cons y = Cons (x++y)+ instance Monoid T where    mempty = Cons mempty-   mappend (Cons x) (Cons y) = Cons (mappend x y)+   mappend = (<>)  single :: String -> T single x = Cons [x]
+ src/Sound/Sox/Private/Information.hs view
@@ -0,0 +1,99 @@+{- |+This module calls the 'soxi' command+which is available since 'sox' version 14.++This module is very clever as it calls 'soxi' once+with one option per requested piece of information+and parses the results in a correctly typed tuple.+Unfortunately, 'soxi' does not work this way.+It accepts only one option per call.+-}+module Sound.Sox.Private.Information where++import Control.Monad.Trans.Writer (Writer, writer, runWriter, )+import Control.Monad.Trans.State (StateT(StateT), runStateT, )+import Control.Monad.Trans.Class (lift, )+import Control.Applicative (Applicative, pure, liftA3, (<*>), )+import Data.Functor.Compose (Compose(Compose), )+import Data.List.HT (viewL, )+import Data.String.HT (trim, )+import Text.Read.HT (maybeRead, )++import qualified System.Process as Proc+import qualified System.IO as IO+import Control.Exception (bracket, )+-- import System.IO.Error (ioError, userError, )+-- import System.Exit (ExitCode, )++import Prelude hiding (length, )+++{-+Cf. Synthesizer.Basic.Interpolation.PrefixReader.+-}+newtype T a =+   Cons (Compose (Writer [String]) (StateT [String] Maybe) a)++instance Functor T where+   {-# INLINE fmap #-}+   fmap f (Cons m) = Cons (fmap f m)++instance Applicative T where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure = Cons . pure+   (Cons f) <*> (Cons x) = Cons (f <*> x)+++simple :: Read a => (String -> Maybe a) -> String -> T a+simple rd option =+   Cons $ Compose $ writer+      (lift . rd =<< StateT viewL, [option])++format :: T String+format = simple Just "-t"++simpleRead :: String -> T Int+simpleRead = simple (maybeRead . trim)++sampleRate :: T Int+sampleRate = simpleRead "-r"++numberOfChannels :: T Int+numberOfChannels = simpleRead "-c"++length :: T Int+length = simpleRead "-s"++bitsPerSample :: T Int+bitsPerSample = simpleRead "-b"++++get :: T a -> FilePath -> IO a+get (Cons (Compose w)) fileName =+   let (parser, opts) = runWriter w+   in  bracket+          (Proc.runInteractiveProcess "soxi"+              (opts ++ fileName : [])+              Nothing Nothing)+          (\(input,output,err,proc) ->+              mapM_ IO.hClose [input, output, err] >>+              Proc.terminateProcess proc)+          (\(_,output,_,_) ->+             maybe+                (ioError (userError "soxi returned rubbish"))+                (\(x,str) ->+                    if null str+                      then return x+                      else ioError (userError "soxi returned more lines than expected")) .+             runStateT parser . lines =<<+             IO.hGetContents output)++exampleMulti :: IO (String, Int, Int)+exampleMulti =+   get (liftA3 (,,) format sampleRate bitsPerSample) "test.aiff"++exampleSingle :: IO Int+exampleSingle =+   get sampleRate "test.aiff"
src/Sound/Sox/Private/Option.hs view
@@ -2,7 +2,8 @@  import qualified Sound.Sox.Private.Arguments as Args import qualified Data.Map as Map-import Data.Monoid (Monoid(..), )+import Data.Monoid (Monoid(mappend, mempty), )+import Data.Semigroup (Semigroup((<>)), )  {- | You can combine options using the 'Monoid' functions 'mappend' and 'mconcat'.@@ -11,9 +12,12 @@ -} newtype T = Cons {decons :: Map.Map String [String]} +instance Semigroup T where+   Cons x <> Cons y = Cons (Map.union x y)+ instance Monoid T where    mempty = Cons mempty-   mappend (Cons x) (Cons y) = Cons (Map.union x y)+   mappend = (<>)  toArguments :: T -> Args.T toArguments =
src/Sound/Sox/Read.hs view
@@ -44,8 +44,8 @@ However there is @soxi@ for this purpose, which we may support in future.  > :load Sound.Sox.Read Sound.Sox.Signal.List->-> open Option.none "test.aiff" >>= withHandle2 Sound.Sox.Signal.List.getContents >>= (\x -> print (Control.Monad.Exception.Asynchronous.result x :: [Data.Int.Int16]))+> :module + Control.Exception+> bracket (open Option.none "test.aiff") close $ \h -> withHandle2 Sound.Sox.Signal.List.getContents h >>= \x -> print (Control.Monad.Exception.Asynchronous.result x :: [Data.Int.Int16]) -} open ::    (Frame.C y) =>
src/Sound/Sox/Signal/List.hs view
@@ -17,13 +17,13 @@ import qualified Control.Monad.Exception.Synchronous as Sync import qualified Control.Monad.Exception.Asynchronous as Async -import Control.Monad.Trans (lift, )+import Control.Monad.Trans.Class (lift, )  import Foreign.Storable (Storable (..), ) -import Foreign (Ptr, alloca, sizeOf, poke, peek, )+import Foreign (Ptr, alloca, ) import System.IO (withBinaryFile, IOMode(WriteMode,ReadMode), Handle, hPutBuf, hGetBuf, )-import Control.Exception (Exception, try, )+import Control.Exception.Extensible (SomeException, try, ) import Control.Monad (liftM)  import System.IO.Unsafe (unsafeInterleaveIO, )@@ -51,7 +51,7 @@   deriving (Show, Eq, Enum)  type IOReadException =-   Either ReadException Exception+   Either ReadException SomeException  withReadFile :: Storable a =>    FilePath ->@@ -66,6 +66,7 @@ getContents h =    alloca $       \p ->+--         Async.eatNothingT $          liftM (\(Async.Exceptional (Just e) a) -> Async.Exceptional e a) $          Async.manySynchronousT             unsafeInterleaveIO
− src/Sound/Sox/StorableUtility.hs 
@@ -1,43 +0,0 @@-{- |-support for Storable instances--Cf. synthesizer package--}-module Sound.Sox.StorableUtility where--import Control.Monad.Trans.State (StateT, evalStateT, get, put, )-import Control.Monad.Trans (lift, )--import Foreign.Ptr (Ptr, castPtr, )-import Foreign.Storable (Storable(..))-import Foreign.Marshal.Array (advancePtr, )---{-# INLINE roundUp #-}-roundUp :: Int -> Int -> Int-roundUp m x = x + mod (-x) m--{-# INLINE sizeOfArray #-}-sizeOfArray :: Storable a => Int -> a -> Int-sizeOfArray n x =-   n * roundUp (alignment x) (sizeOf x)--{-# INLINE pokeNext #-}-pokeNext :: (Storable a) => a -> StateT (Ptr a) IO ()-pokeNext x =-   do ptr <- get-      lift $ poke ptr x-      put (ptr `advancePtr` 1)---      put (ptr `plusPtr` size x + div (- size x) (alignment x))--{-# INLINE peekNext #-}-peekNext :: (Storable a) => StateT (Ptr a) IO a-peekNext =-   do ptr <- get-      a <- lift $ peek ptr-      put (ptr `advancePtr` 1)-      return a--run :: Ptr (t a) -> StateT (Ptr a) IO c -> IO c-run ptr act =-   evalStateT act (castPtr ptr)
src/Sound/Sox/Write.hs view
@@ -1,4 +1,4 @@-module Sound.Sox.Write where+module Sound.Sox.Write (simple, extended, manyExtended, ) where  import qualified Sound.Sox.Frame as Frame import Sound.Sox.System (catchCtrlC, )@@ -8,6 +8,9 @@ import qualified Sound.Sox.Private.Arguments as Args import Data.Monoid (mconcat, ) +import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+ import qualified System.Process as Proc import qualified System.IO as IO import Control.Exception (bracket, )@@ -21,7 +24,7 @@  > :load Sound.Sox.Write Sound.Sox.Signal.List >-> generic Sound.Sox.Signal.List.put Option.none "test.aiff" 11025 (take 100 $ iterate (1000+) (0::Data.Int.Int16))+> simple Sound.Sox.Signal.List.put Option.none "test.aiff" 11025 (take 100 $ iterate (1000+) (0::Data.Int.Int16)) -} simple ::    (Frame.C y) =>@@ -53,28 +56,81 @@       {- ^ sample rate -} ->    sig y ->    IO ExitCode-extended write srcOpts dstOpts fileName sampleRate stream =+extended write srcOpts dstOpts fileName sampleRate signal =    bracket-      (Proc.runInteractiveProcess "sox"-          (Args.decons $ mconcat $-           OptPriv.toArguments-             (mconcat $-              srcOpts :-              Option.numberOfChannels-                 (Frame.withSignal Frame.numberOfChannels stream) :-              Option.sampleRate sampleRate :-              Option.format (Frame.withSignal Frame.format stream) :-              []) :-           Args.pipe :-           OptPriv.toArguments dstOpts :-           Args.fileName fileName :-           [])-          Nothing Nothing)-      (\(input,output,err,_proc) ->-          mapM_ IO.hClose [input, output, err])+      (open srcOpts dstOpts fileName sampleRate signal)+      close       (\(input,_,_,proc) ->          catchCtrlC >>-         write input stream >>+         write input signal >>          return proc)    -- get exit code, e.g. when options were wrong    >>= Proc.waitForProcess++{- |+The traversable functor @f@ might be 'Maybe' or '[]'.+It allows you to write to many files simultaneously+and returns the exit codes of all writing processes.+-}+manyExtended ::+   (Frame.C y, Trav.Traversable f) =>+   (f IO.Handle -> sig y -> IO ())+      {- ^ Writer routine -+           e.g. 'Sound.Sox.Signal.List.put'+           or 'Data.StorableVector.hPut' -} ->+   Option.T+      {- ^ source options, usually none -} ->+   Option.T+      {- ^ target options -} ->+   f FilePath ->+   Int+      {- ^ sample rate -} ->+   sig y ->+   IO (f ExitCode)+manyExtended write srcOpts dstOpts fileNames sampleRate signal =+   bracket+      (Trav.traverse+         (\fileName -> open srcOpts dstOpts fileName sampleRate signal)+         fileNames)+      (Fold.traverse_ close)+      (\handles ->+         catchCtrlC >>+         write (fmap (\(input,_,_,_) -> input) handles) signal >>+         return (fmap (\(_,_,_,proc) -> proc) handles))+   -- get exit code, e.g. when options were wrong+   >>= Trav.traverse Proc.waitForProcess+++type Handle = (IO.Handle, IO.Handle, IO.Handle, Proc.ProcessHandle)++open ::+   (Frame.C y) =>+   Option.T+      {- ^ source options, usually none -} ->+   Option.T+      {- ^ target options -} ->+   FilePath ->+   Int+      {- ^ sample rate -} ->+   sig y ->+   IO Handle+open srcOpts dstOpts fileName sampleRate signal =+   Proc.runInteractiveProcess "sox"+      (Args.decons $ mconcat $+       OptPriv.toArguments+         (mconcat $+          srcOpts :+          Option.numberOfChannels+             (Frame.withSignal Frame.numberOfChannels signal) :+          Option.sampleRate sampleRate :+          Option.format (Frame.withSignal Frame.format signal) :+          []) :+       Args.pipe :+       OptPriv.toArguments dstOpts :+       Args.fileName fileName :+       [])+      Nothing Nothing++close :: Handle -> IO ()+close (input,output,err,_proc) =+   mapM_ IO.hClose [input, output, err]