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, Word32, )
import Data.Int (Int8, Int16, Int32, )


class Frame.C y => C y where
   format :: y -> Format.T


instance C Word8 where
   format :: Word8 -> T
format Word8
_ = T
Format.unsignedByte

instance C Int8 where
   format :: Int8 -> T
format Int8
_ = T
Format.signedByte

instance C Word16 where
   format :: Word16 -> T
format Word16
_ = T
Format.unsignedWord

instance C Int16 where
   format :: Int16 -> T
format Int16
_ = T
Format.signedWord

instance C Word32 where
   format :: Word32 -> T
format Word32
_ = T
Format.unsignedLong

instance C Int32 where
   format :: Int32 -> T
format Int32
_ = T
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 :: Float -> T
format Float
_ = T
Format.ieeeSinglePrecision

instance C Double where
   format :: Double -> T
format Double
_ = T
Format.ieeeDoublePrecision

instance C MuLaw.T where
   format :: T -> T
format T
_ = T
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 :: T a -> T
format T a
y = forall y. C y => y -> T
format (forall a. T a -> a
Stereo.left T a
y)