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

-- |

-- Module      : Data.Audio

-- Copyright   : George Giorgidze

-- License     : BSD3

--

-- Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/>

-- Stability   : Experimental

-- Portability : Portable

--

-- General purpose data type for representing an audio data.

--

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


{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.Audio (
   Sample
 , Audio (..)
 , SampleData
 , SampleMode(..)
 , sampleType
 , sampleNumber
 , convert
 , parseSampleData
 , buildSampleData
 , Audible
 , toSample
 , fromSample
 ) where

import Data.Array.IO     (MArray, IOUArray, newArray_, writeArray)
import Data.Array.Unsafe (unsafeFreeze, unsafeThaw)

import Codec.Internal.Arbitrary
import Codec.ByteString.Parser
import Codec.ByteString.Builder

import Test.QuickCheck
import System.IO.Unsafe
import Data.Array.Unboxed
import Data.Word
import Data.Int
import Data.Monoid (mconcat)

type Sample = Double
type SampleData a = UArray Int a

class Audible a where
  toSample :: a -> Sample
  fromSample :: Sample -> a

-- It is required that sampleNummer `mod` channelNumber == 0

data Audio a = Audio {
    Audio a -> Int
sampleRate :: Int
  , Audio a -> Int
channelNumber :: Int
  , Audio a -> SampleData a
sampleData :: SampleData a
  }

instance (Eq a, IArray UArray a) => Eq (Audio a) where
  Audio a
a1 == :: Audio a -> Audio a -> Bool
== Audio a
a2 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [
      Audio a -> Int
forall a. Audio a -> Int
sampleRate Audio a
a1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Audio a -> Int
forall a. Audio a -> Int
sampleRate Audio a
a2
    , Audio a -> Int
forall a. Audio a -> Int
channelNumber Audio a
a1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Audio a -> Int
forall a. Audio a -> Int
channelNumber Audio a
a2
    , UArray Int a -> [(Int, a)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs (Audio a -> UArray Int a
forall a. Audio a -> SampleData a
sampleData Audio a
a1) [(Int, a)] -> [(Int, a)] -> Bool
forall a. Eq a => a -> a -> Bool
== UArray Int a -> [(Int, a)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs (Audio a -> UArray Int a
forall a. Audio a -> SampleData a
sampleData Audio a
a2)]


instance (Show a, IArray UArray a) => Show (Audio a) where
  show :: Audio a -> String
show Audio a
a = String
"Sample Rate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Audio a -> Int
forall a. Audio a -> Int
sampleRate Audio a
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
           String
"Channel Number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Audio a -> Int
forall a. Audio a -> Int
channelNumber Audio a
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
           String
"Sample Data Array Bounds: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((Int, Int) -> String
forall a. Show a => a -> String
show ((Int, Int) -> String) -> (Int, Int) -> String
forall a b. (a -> b) -> a -> b
$ UArray Int a -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds (UArray Int a -> (Int, Int)) -> UArray Int a -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Audio a -> UArray Int a
forall a. Audio a -> SampleData a
sampleData Audio a
a)


instance (Arbitrary a, IArray UArray a) => Arbitrary (Audio a) where
  arbitrary :: Gen (Audio a)
arbitrary = do
    Int
sr <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
44100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
    Int
cn <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
8)
    Word
sn <- (Word, Word) -> Gen Word
forall a. Random a => (a, a) -> Gen a
choose (Word
1, Word
128) Gen Word -> (Word -> Gen Word) -> Gen Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Gen Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Gen Word) -> (Word -> Word) -> Word -> Gen Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cn Word -> Word -> Word
forall a. Num a => a -> a -> a
*)
    UArray Int a
sd <- Word -> Gen (UArray Int a)
forall e i (a :: * -> * -> *).
(Arbitrary e, Num i, IArray a e, Ix i) =>
Word -> Gen (a i e)
arrayGen Word
sn
    Audio a -> Gen (Audio a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> UArray Int a -> Audio a
forall a. Int -> Int -> SampleData a -> Audio a
Audio Int
sr Int
cn UArray Int a
sd)

sampleNumber :: (IArray UArray a) => SampleData a -> Int
sampleNumber :: SampleData a -> Int
sampleNumber SampleData a
sd = ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (SampleData a -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds SampleData a
sd)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

sampleType :: (IArray UArray a) => SampleData a -> a
sampleType :: SampleData a -> a
sampleType SampleData a
sd = a
forall a. HasCallStack => a
undefined a -> a -> a
forall a. a -> a -> a
`asTypeOf` (SampleData a
sd SampleData a -> Int -> a
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
0)

convert :: (Audible a, Audible b, IArray UArray a, IArray UArray b) => SampleData a -> SampleData b
convert :: SampleData a -> SampleData b
convert SampleData a
sd = (a -> b) -> SampleData a -> SampleData b
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
amap (Sample -> b
forall a. Audible a => Sample -> a
fromSample (Sample -> b) -> (a -> Sample) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Sample
forall a. Audible a => a -> Sample
toSample) SampleData a
sd

parseSampleData :: (MArray IOUArray a IO, IArray UArray a) => Int -> Parser a -> Parser (SampleData a)
parseSampleData :: Int -> Parser a -> Parser (SampleData a)
parseSampleData Int
sn Parser a
p = Int -> SampleData a -> Parser (SampleData a)
pAux Int
0 SampleData a
unsafeNewArray
  where
  pAux :: Int -> SampleData a -> Parser (SampleData a)
pAux Int
i SampleData a
acc | (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sn) = Int -> Parser (SampleData a) -> Parser (SampleData a)
seq Int
i (Parser (SampleData a) -> Parser (SampleData a))
-> Parser (SampleData a) -> Parser (SampleData a)
forall a b. (a -> b) -> a -> b
$ SampleData a -> Parser (SampleData a) -> Parser (SampleData a)
seq SampleData a
acc (Parser (SampleData a) -> Parser (SampleData a))
-> Parser (SampleData a) -> Parser (SampleData a)
forall a b. (a -> b) -> a -> b
$ SampleData a -> Parser (SampleData a)
forall (m :: * -> *) a. Monad m => a -> m a
return SampleData a
acc
  pAux Int
i SampleData a
acc | Bool
otherwise = Int -> Parser (SampleData a) -> Parser (SampleData a)
seq Int
i (Parser (SampleData a) -> Parser (SampleData a))
-> Parser (SampleData a) -> Parser (SampleData a)
forall a b. (a -> b) -> a -> b
$ SampleData a -> Parser (SampleData a) -> Parser (SampleData a)
seq SampleData a
acc (Parser (SampleData a) -> Parser (SampleData a))
-> Parser (SampleData a) -> Parser (SampleData a)
forall a b. (a -> b) -> a -> b
$ do
    a
s <- Parser a
p
    a -> Parser (SampleData a) -> Parser (SampleData a)
seq a
s (Int -> SampleData a -> Parser (SampleData a)
pAux (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (SampleData a -> Int -> a -> SampleData a
forall a (a :: * -> * -> *).
(MArray IOUArray a IO, IArray a a, IArray UArray a) =>
a Int a -> Int -> a -> SampleData a
unsafeWriteArray SampleData a
acc Int
i a
s))

  unsafeFreezeAux :: (MArray IOUArray a IO, IArray UArray a) => IOUArray Int a -> IO (SampleData a)
  unsafeFreezeAux :: IOUArray Int a -> IO (SampleData a)
unsafeFreezeAux = IOUArray Int a -> IO (SampleData a)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze

  unsafeNewArray :: SampleData a
unsafeNewArray         = IO (SampleData a) -> SampleData a
forall a. IO a -> a
unsafePerformIO ((Int, Int) -> IO (IOUArray Int a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Int
0, Int
sn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) IO (IOUArray Int a)
-> (IOUArray Int a -> IO (SampleData a)) -> IO (SampleData a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IOUArray Int a -> IO (SampleData a)
forall a.
(MArray IOUArray a IO, IArray UArray a) =>
IOUArray Int a -> IO (SampleData a)
unsafeFreezeAux )
  unsafeWriteArray :: a Int a -> Int -> a -> SampleData a
unsafeWriteArray a Int a
a Int
i a
e = IO (SampleData a) -> SampleData a
forall a. IO a -> a
unsafePerformIO (do IOUArray Int a
a' <- a Int a -> IO (IOUArray Int a)
forall i (a :: * -> * -> *) e (b :: * -> * -> *) (m :: * -> *).
(Ix i, IArray a e, MArray b e m) =>
a i e -> m (b i e)
unsafeThaw a Int a
a; IOUArray Int a -> Int -> a -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int a
a' Int
i a
e; IOUArray Int a -> IO (SampleData a)
forall a.
(MArray IOUArray a IO, IArray UArray a) =>
IOUArray Int a -> IO (SampleData a)
unsafeFreezeAux IOUArray Int a
a';)


buildSampleData :: (IArray UArray a) => (a -> Builder) -> SampleData a -> Builder
buildSampleData :: (a -> Builder) -> SampleData a -> Builder
buildSampleData a -> Builder
b = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (SampleData a -> [Builder]) -> SampleData a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
b ([a] -> [Builder])
-> (SampleData a -> [a]) -> SampleData a -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SampleData a -> [a]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems

instance Audible Int8 where
  toSample :: Int8 -> Sample
toSample Int8
a = (Int8 -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
a) Sample -> Sample -> Sample
forall a. Fractional a => a -> a -> a
/ (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
7)
  fromSample :: Sample -> Int8
fromSample Sample
s = Sample -> Int8
forall a b. (RealFrac a, Integral b) => a -> b
round (Sample -> Int8) -> Sample -> Int8
forall a b. (a -> b) -> a -> b
$ Sample
s Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
* (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
7)
instance Audible Int16 where
  toSample :: Int16 -> Sample
toSample Int16
a = (Int16 -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
a) Sample -> Sample -> Sample
forall a. Fractional a => a -> a -> a
/ (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
15)
  fromSample :: Sample -> Int16
fromSample Sample
s = Sample -> Int16
forall a b. (RealFrac a, Integral b) => a -> b
round (Sample -> Int16) -> Sample -> Int16
forall a b. (a -> b) -> a -> b
$ Sample
s Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
* (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
15)
instance Audible Int32 where
  toSample :: Int32 -> Sample
toSample Int32
a = (Int32 -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
a) Sample -> Sample -> Sample
forall a. Fractional a => a -> a -> a
/ (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
31)
  fromSample :: Sample -> Int32
fromSample Sample
s = Sample -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
round (Sample -> Int32) -> Sample -> Int32
forall a b. (a -> b) -> a -> b
$ Sample
s Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
* (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
31)
instance Audible Int64 where
  toSample :: Int64 -> Sample
toSample Int64
a = (Int64 -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a) Sample -> Sample -> Sample
forall a. Fractional a => a -> a -> a
/ (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
63)
  fromSample :: Sample -> Int64
fromSample Sample
s = Sample -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (Sample -> Int64) -> Sample -> Int64
forall a b. (a -> b) -> a -> b
$ Sample
s Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
* (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
63)
instance Audible Word8 where
  toSample :: Word8 -> Sample
toSample Word8
a = (Word8 -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a) Sample -> Sample -> Sample
forall a. Fractional a => a -> a -> a
/ (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
7) Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
- Sample
1.0
  fromSample :: Sample -> Word8
fromSample Sample
s = Sample -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
round (Sample -> Word8) -> Sample -> Word8
forall a b. (a -> b) -> a -> b
$ (Sample
s Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
+ Sample
1.0) Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
* (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
7)
instance Audible Word16 where
  toSample :: Word16 -> Sample
toSample Word16
a = (Word16 -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a) Sample -> Sample -> Sample
forall a. Fractional a => a -> a -> a
/ (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
15) Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
- Sample
1.0
  fromSample :: Sample -> Word16
fromSample Sample
s = Sample -> Word16
forall a b. (RealFrac a, Integral b) => a -> b
round (Sample -> Word16) -> Sample -> Word16
forall a b. (a -> b) -> a -> b
$ (Sample
s Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
+ Sample
1.0) Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
* (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
15)
instance Audible Word32 where
  toSample :: Word32 -> Sample
toSample Word32
a = (Word32 -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a) Sample -> Sample -> Sample
forall a. Fractional a => a -> a -> a
/ (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
31) Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
- Sample
1.0
  fromSample :: Sample -> Word32
fromSample Sample
s = Sample -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
round (Sample -> Word32) -> Sample -> Word32
forall a b. (a -> b) -> a -> b
$ (Sample
s Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
+ Sample
1.0) Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
* (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
31)
instance Audible Word64 where
  toSample :: Word64 -> Sample
toSample Word64
a = (Word64 -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a) Sample -> Sample -> Sample
forall a. Fractional a => a -> a -> a
/ (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
63) Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
- Sample
1.0
  fromSample :: Sample -> Word64
fromSample Sample
s = Sample -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
round (Sample -> Word64) -> Sample -> Word64
forall a b. (a -> b) -> a -> b
$ (Sample
s Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
+ Sample
1.0) Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
* (Sample
2 Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
** Sample
63)

instance Audible Float where
  toSample :: Float -> Sample
toSample = Float -> Sample
forall a b. (Real a, Fractional b) => a -> b
realToFrac
  fromSample :: Sample -> Float
fromSample = Sample -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance Audible Double where
  toSample :: Sample -> Sample
toSample = Sample -> Sample
forall a. a -> a
id
  fromSample :: Sample -> Sample
fromSample = Sample -> Sample
forall a. a -> a
id

data SampleMode = NoLoop | ContLoop | PressLoop deriving (SampleMode -> SampleMode -> Bool
(SampleMode -> SampleMode -> Bool)
-> (SampleMode -> SampleMode -> Bool) -> Eq SampleMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SampleMode -> SampleMode -> Bool
$c/= :: SampleMode -> SampleMode -> Bool
== :: SampleMode -> SampleMode -> Bool
$c== :: SampleMode -> SampleMode -> Bool
Eq, Int -> SampleMode -> ShowS
[SampleMode] -> ShowS
SampleMode -> String
(Int -> SampleMode -> ShowS)
-> (SampleMode -> String)
-> ([SampleMode] -> ShowS)
-> Show SampleMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SampleMode] -> ShowS
$cshowList :: [SampleMode] -> ShowS
show :: SampleMode -> String
$cshow :: SampleMode -> String
showsPrec :: Int -> SampleMode -> ShowS
$cshowsPrec :: Int -> SampleMode -> ShowS
Show)

instance Arbitrary SampleMode where
  arbitrary :: Gen SampleMode
arbitrary = [Gen SampleMode] -> Gen SampleMode
forall a. [Gen a] -> Gen a
oneof [SampleMode -> Gen SampleMode
forall (m :: * -> *) a. Monad m => a -> m a
return SampleMode
NoLoop, SampleMode -> Gen SampleMode
forall (m :: * -> *) a. Monad m => a -> m a
return SampleMode
ContLoop, SampleMode -> Gen SampleMode
forall (m :: * -> *) a. Monad m => a -> m a
return SampleMode
PressLoop]