{-
This data type can be used as sample type for stereo signals.
-}
module Sound.Frame.Stereo (
   T, left, right, cons, map,
   swap,
   Channel(..), select,
   interleave, sequence, liftApplicative,
   ) where

import qualified Sound.Frame as Frame

import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold

import Control.Applicative (Applicative, pure, (<*>), liftA2, )
import Control.Monad (liftM2, )

import Foreign.Storable (Storable (..), )
import Foreign.Ptr (Ptr, castPtr, )

import Test.QuickCheck (Arbitrary(arbitrary), )

import Prelude hiding (Either(Left, Right), map, sequence, )


data T a = Cons {forall a. T a -> a
left, forall a. T a -> a
right :: !a}
   deriving (T a -> T a -> Bool
forall a. Eq a => T a -> T a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T a -> T a -> Bool
$c/= :: forall a. Eq a => T a -> T a -> Bool
== :: T a -> T a -> Bool
$c== :: forall a. Eq a => T a -> T a -> Bool
Eq)


instance Show a => Show (T a) where
   showsPrec :: Int -> T a -> ShowS
showsPrec Int
p T a
x =
      Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
10)
         (String -> ShowS
showString String
"Stereo.cons " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (forall a. T a -> a
left T a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (forall a. T a -> a
right T a
x))

instance (Arbitrary a) => Arbitrary (T a) where
   arbitrary :: Gen (T a)
arbitrary = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. a -> a -> T a
cons forall a. Arbitrary a => Gen a
arbitrary forall a. Arbitrary a => Gen a
arbitrary


{-# INLINE cons #-}
cons :: a -> a -> T a
cons :: forall a. a -> a -> T a
cons = forall a. a -> a -> T a
Cons

{-# INLINE map #-}
map :: (a -> b) -> T a -> T b
map :: forall a b. (a -> b) -> T a -> T b
map a -> b
f (Cons a
l a
r) = forall a. a -> a -> T a
Cons (a -> b
f a
l) (a -> b
f a
r)


swap :: T a -> T a
swap :: forall a. T a -> T a
swap T a
x = forall a. a -> a -> T a
cons (forall a. T a -> a
right T a
x) (forall a. T a -> a
left T a
x)



data Channel = Left | Right

{-# INLINE select #-}
select :: T a -> Channel -> a
select :: forall a. T a -> Channel -> a
select T a
x Channel
c =
   case Channel
c of
      Channel
Left -> forall a. T a -> a
left T a
x
      Channel
Right -> forall a. T a -> a
right T a
x

{-# INLINE interleave #-}
interleave :: (T a, T b) -> T (a,b)
interleave :: forall a b. (T a, T b) -> T (a, b)
interleave = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,))

{-# INLINE sequence #-}
sequence :: (Functor f) => f (T a) -> T (f a)
sequence :: forall (f :: * -> *) a. Functor f => f (T a) -> T (f a)
sequence f (T a)
x = forall a. a -> a -> T a
cons (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. T a -> a
left f (T a)
x) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. T a -> a
right f (T a)
x)

{-# INLINE liftApplicative #-}
liftApplicative ::
   (Applicative f) =>
   (f a -> f b) -> f (T a) -> f (T b)
liftApplicative :: forall (f :: * -> *) a b.
Applicative f =>
(f a -> f b) -> f (T a) -> f (T b)
liftApplicative f a -> f b
proc =
   forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
Trav.sequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> f b
proc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f (T a) -> T (f a)
sequence


instance Functor T where
   {-# INLINE fmap #-}
   fmap :: forall a b. (a -> b) -> T a -> T b
fmap = forall a b. (a -> b) -> T a -> T b
map

-- useful for defining Additive instance
instance Applicative T where
   {-# INLINE pure #-}
   pure :: forall a. a -> T a
pure a
a = forall a. a -> a -> T a
Cons a
a a
a
   {-# INLINE (<*>) #-}
   Cons a -> b
fl a -> b
fr <*> :: forall a b. T (a -> b) -> T a -> T b
<*> Cons a
l a
r = forall a. a -> a -> T a
Cons (a -> b
fl a
l) (a -> b
fr a
r)

instance Fold.Foldable T where
   {-# INLINE foldMap #-}
   foldMap :: forall m a. Monoid m => (a -> m) -> T a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Trav.foldMapDefault

-- this allows for kinds of generic programming
instance Trav.Traversable T where
   {-# INLINE sequenceA #-}
   sequenceA :: forall (f :: * -> *) a. Applicative f => T (f a) -> f (T a)
sequenceA ~(Cons f a
l f a
r) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> T a
Cons f a
l f a
r



{-# INLINE castToElemPtr #-}
castToElemPtr :: Ptr (T a) -> Ptr a
castToElemPtr :: forall a. Ptr (T a) -> Ptr a
castToElemPtr = forall a b. Ptr a -> Ptr b
castPtr

instance (Storable a) => Storable (T a) where
   {-# INLINE sizeOf #-}
   {-# INLINE alignment #-}
   {-# INLINE peek #-}
   {-# INLINE poke #-}
   -- cf. storable-record:FixedArray.roundUp
   sizeOf :: T a -> Int
sizeOf ~(Cons a
l a
r) =
      forall a. Storable a => a -> Int
sizeOf a
l forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
mod (- forall a. Storable a => a -> Int
sizeOf a
l) (forall a. Storable a => a -> Int
alignment a
r) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf a
r
   alignment :: T a -> Int
alignment ~(Cons a
l a
_) = forall a. Storable a => a -> Int
alignment a
l
   poke :: Ptr (T a) -> T a -> IO ()
poke Ptr (T a)
p (Cons a
l a
r) =
      let q :: Ptr a
q = forall a. Ptr (T a) -> Ptr a
castToElemPtr Ptr (T a)
p
      in  forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
q a
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
q Int
1 a
r
   peek :: Ptr (T a) -> IO (T a)
peek Ptr (T a)
p =
      let q :: Ptr a
q = forall a. Ptr (T a) -> Ptr a
castToElemPtr Ptr (T a)
p
      in  forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. a -> a -> T a
Cons
             (forall a. Storable a => Ptr a -> IO a
peek Ptr a
q) (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
q Int
1)


instance Frame.C a => Frame.C (T a) where
   {-# INLINE numberOfChannels #-}
   numberOfChannels :: T a -> Int
numberOfChannels T a
y = Int
2 forall a. Num a => a -> a -> a
* forall y. C y => y -> Int
Frame.numberOfChannels (forall a. T a -> a
left T a
y)
   {-# INLINE sizeOfElement #-}
   sizeOfElement :: T a -> Int
sizeOfElement = forall y. C y => y -> Int
Frame.sizeOfElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> a
left