{-# language TypeApplications #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Channels
  ( channelTests
  ) where

import Data.Proxy

import Test.QuickCheck
import Test.QuickCheck.Classes

import Sound.Wave.Channels

channelTests :: IO ()
channelTests = do
  lawsCheckMany
    [ ("StereoWord8",  [primLaws (Proxy @StereoWord8)])
    , ("StereoInt16",  [primLaws (Proxy @StereoInt16)])
    , ("StereoInt32",  [primLaws (Proxy @StereoInt32)])
    , ("StereoFloat",  [primLaws (Proxy @StereoFloat)])
    , ("StereoDouble", [primLaws (Proxy @StereoDouble)])
    ]

instance Arbitrary StereoWord8 where
  arbitrary = StereoWord8
    <$> arbitrary
    <*> arbitrary
  shrink = recursivelyShrink

instance Arbitrary StereoInt16 where
  arbitrary = StereoInt16
    <$> arbitrary
    <*> arbitrary
  shrink = recursivelyShrink

instance Arbitrary StereoInt32 where
  arbitrary = StereoInt32
    <$> arbitrary
    <*> arbitrary
  shrink = recursivelyShrink

instance Arbitrary StereoFloat where
  arbitrary = StereoFloat
    <$> arbitrary
    <*> arbitrary
  shrink = recursivelyShrink

instance Arbitrary StereoDouble where
  arbitrary = StereoDouble
    <$> arbitrary
    <*> arbitrary
  shrink = recursivelyShrink