{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_HADDOCK prune #-}
{-|
Module : $Header$
CopyRight : (c) 2011-2013, 8c6794b6
License : BSD3
Maintainer : 8c6794b6@gmail.com
Stability : experimental
Portability : non-portable
Read and write audio file with repa arrays using libsndfile via hsndfile.
Note that this module re-exports header related types from hsndfile.
For more info about supported format, visit libsndfile web site:
* libsndfile:
* hsndfile
-}
module Data.Array.Repa.IO.Sndfile
(
-- * Examples
-- $examples
-- * Sound file reader and writer
readSF
, writeSF
, withSF
-- * Sound file headers (re-exports from hsndfile)
, S.Info(..)
, S.Format(..)
, S.HeaderFormat(..)
, S.EndianFormat(..)
, S.SampleFormat(..)
, S.Count
-- * Utils
, toMC
, fromMC
, wav16
, wav32
) where
import Foreign.ForeignPtr (ForeignPtr)
import Data.Array.Repa (Array, DIM1, DIM2, Z(..), (:.)(..), Source)
import Data.Array.Repa.Eval (Target)
import Data.Array.Repa.Repr.ForeignPtr (F)
import Data.Int (Int16, Int32)
import Sound.File.Sndfile (Buffer(..), Info(..), Sample)
import qualified Data.Array.Repa as R
import qualified Data.Array.Repa.Repr.ForeignPtr as RF
import qualified Sound.File.Sndfile as S
{-$examples
Read \"in.wav\", write to \"out.wav\" with same format.
> module Main where
>
> import Data.Array.Repa
> ((:.)(..), Array, Z(..), DIM2, computeP, fromFunction)
> import Data.Array.Repa.Repr.ForeignPtr (F)
> import Data.Array.Repa.IO.Sndfile
>
> main :: IO ()
> main = do
> (i, a) <- readSF "in.wav" :: IO (Info, Array F DIM2 Double)
> writeSF "out.wav" i a
Write 440hz sine wave for 3 seconds to monaural file \"sin440.wav\".
> sin440 :: IO ()
> sin440 = do
> let dur = 3; freq = 440; sr = 48000
> hdr = wav16 {samplerate = sr, frames = sr * dur}
> sig = fromFunction (Z :. 1 :. dur * sr) $ \(_ :. _ :. i) ->
> sin (fromIntegral i * freq * pi * 2 / fromIntegral sr)
> sig' <- computeP sig :: IO (Array F DIM2 Double)
> writeSF "sin440.wav" hdr sig'
Write 440hz sine wave to channel 0, 880hz sine wave to channel 1, for 3 seconds
to stereo file \"sin440and330.wav\".
> sin440and880 :: IO ()
> sin440and880 = do
> let dur = 3; freq1 = 440; freq2 = 880; sr = 480000
> hdr = wav16 {samplerate = sr, channels = 2, frames = sr * dur * 2}
> gen f i = sin (fromIntegral i * f * pi * 2 / fromIntegral sr)
> sig = R.fromFunction (Z :. 2 :. dur * sr) $ \(_ :. c :. i) ->
> case c of
> 0 -> gen freq1 i
> 1 -> gen freq2 i
> _ -> 0
> sig' <- R.computeP sig :: IO (Array F DIM2 Double)
> writeSF "sin440and880.wav" hdr sig'
-}
-- ---------------------------------------------------------------------------
-- Wrapper actions
-- | Read sound file from given path.
--
-- Returns a tuple of Info and array containing the samples of sound
-- file. Returned pair contains sound file information and array which
-- is indexed with channel number and frame. Info could used later for
-- writing sound file.
--
readSF ::
forall a r. (Sample a, Source r a, Target r a, Buffer (Array F DIM1) a)
=> FilePath -> IO (Info, Array r DIM2 a)
readSF path = do
(info, arr) <- S.readFile path :: IO (Info, Maybe (Array F DIM1 a))
case arr of
Nothing -> error $ "readSF: failed reading " ++ path
Just arr' -> do
arr'' <- toMC (S.channels info) arr'
return (info, arr'')
{-# INLINEABLE readSF #-}
{-# SPECIALIZE readSF :: FilePath -> IO (Info, Array F DIM2 Double) #-}
{-# SPECIALIZE readSF :: FilePath -> IO (Info, Array F DIM2 Float) #-}
{-# SPECIALIZE readSF :: FilePath -> IO (Info, Array F DIM2 Int16) #-}
{-# SPECIALIZE readSF :: FilePath -> IO (Info, Array F DIM2 Int32) #-}
-- | Write array contents to sound file with given header information.
--
-- Expecting an array indexed with channel and frame, as returned from readSF.
-- i.e. 2-dimensional array with its contents indexed with channel.
--
writeSF ::
forall a r.
(Sample a, Source r a, Buffer (Array r DIM1) a, Target r a)
=> FilePath -> Info -> Array r DIM2 a -> IO ()
writeSF path info arr = do
arr' <- fromMC arr :: IO (Array r DIM1 a)
_ <- S.writeFile info path arr'
return ()
{-# INLINEABLE writeSF #-}
{-# SPECIALIZE writeSF :: FilePath -> Info -> Array F DIM2 Double -> IO () #-}
{-# SPECIALIZE writeSF :: FilePath -> Info -> Array F DIM2 Float -> IO () #-}
{-# SPECIALIZE writeSF :: FilePath -> Info -> Array F DIM2 Int16 -> IO () #-}
{-# SPECIALIZE writeSF :: FilePath -> Info -> Array F DIM2 Int32-> IO () #-}
-- | Wrapper for invoking array with reading sound file.
--
-- Performs given action using sound file info and samples as arguments.
--
withSF
:: forall a b r. (Sample a, Target r a, Source r a)
=> FilePath -> (Info -> Array r DIM2 a -> IO b) -> IO b
withSF path act = do
(info, arr) <- S.readFile path :: IO (Info, Maybe (Array F DIM1 a))
case arr of
Nothing -> error ("withSF: failed to read " ++ path)
Just arr' -> do
arr'' <- toMC (S.channels info) arr' :: IO (Array r DIM2 a)
act info arr''
{-# INLINEABLE withSF #-}
{-# SPECIALIZE withSF
:: FilePath -> (Info -> Array F DIM2 Double -> IO b) -> IO b #-}
{-# SPECIALIZE withSF
:: FilePath -> (Info -> Array F DIM2 Float -> IO b) -> IO b #-}
{-# SPECIALIZE withSF
:: FilePath -> (Info -> Array F DIM2 Int16 -> IO b) -> IO b #-}
{-# SPECIALIZE withSF
:: FilePath -> (Info -> Array F DIM2 Int32 -> IO b) -> IO b #-}
-- ---------------------------------------------------------------------------
-- Internal work
-- | Orphan instance for reading/wriging sound file to array via ForeignPtr.
--
instance Sample e => Buffer (Array F DIM1) e where
-- Read the whole contents to DIM1 array, ignoring channel number.
--
fromForeignPtr fptr _ count = return $ RF.fromForeignPtr (Z :. count) fptr
{-# INLINEABLE fromForeignPtr #-}
{-# SPECIALIZE fromForeignPtr
:: ForeignPtr Double -> Int -> Int -> IO (Array F DIM1 Double) #-}
{-# SPECIALIZE fromForeignPtr
:: ForeignPtr Float -> Int -> Int -> IO (Array F DIM1 Float) #-}
{-# SPECIALIZE fromForeignPtr
:: ForeignPtr Int16 -> Int -> Int -> IO (Array F DIM1 Int16) #-}
{-# SPECIALIZE fromForeignPtr
:: ForeignPtr Int32 -> Int -> Int -> IO (Array F DIM1 Int32) #-}
-- Allocate whole memory for writing, fill in with element of array.
--
toForeignPtr arr = do
let nelem = R.size (R.extent arr)
fptr = RF.toForeignPtr arr
return (fptr, 0, nelem)
{-# INLINEABLE toForeignPtr #-}
{-# SPECIALIZE toForeignPtr
:: Array F DIM1 Double -> IO (ForeignPtr Double, Int, Int) #-}
{-# SPECIALIZE toForeignPtr
:: Array F DIM1 Float -> IO (ForeignPtr Float, Int, Int) #-}
{-# SPECIALIZE toForeignPtr
:: Array F DIM1 Int16 -> IO (ForeignPtr Int16, Int, Int) #-}
{-# SPECIALIZE toForeignPtr
:: Array F DIM1 Int32 -> IO (ForeignPtr Int32, Int, Int) #-}
-- | Converts multi channel signal to vector signal.
fromMC ::
(Source r1 e, Source r2 e, Target r2 e, Monad m)
=> Array r1 DIM2 e -> m (Array r2 DIM1 e)
fromMC arr = R.computeP $ R.backpermute sh' f arr where
sh' = Z :. (nc * nf)
{-# INLINE sh' #-}
_ :. nc :. nf = R.extent arr
f (Z :. i) = Z :. i `mod` nc :. i `div` nc
{-# INLINE f #-}
{-# INLINE fromMC #-}
-- | Converts vector signal to multi channel signal.
toMC ::
(Monad m, Source r1 e, Source r2 e, Target r2 e)
=> Int -> Array r1 DIM1 e -> m (Array r2 DIM2 e)
toMC nc arr = R.computeP $ R.backpermute sh' f arr where
sh' = Z :. nc :. (nf `div` nc)
_ :. nf = R.extent arr
f (Z :. i :. j) = Z :. i + (j * nc)
{-# INLINE toMC #-}
-- | 16 bit MS wave, single channel, sampling rate = 48000.
wav16 :: S.Info
wav16 = S.Info
{ samplerate = 48000
, channels = 1
, frames = 0
, format = S.Format S.HeaderFormatWav S.SampleFormatPcm16 S.EndianFile
, sections = 1
, seekable = True }
{-# INLINE wav16 #-}
-- | 32 bit MS wave, single channel, sampling rate = 48000.
wav32 :: S.Info
wav32 = wav16
{ format = S.Format S.HeaderFormatWav S.SampleFormatPcm32 S.EndianFile }
{-# INLINE wav32 #-}