{-# LANGUAGE CPP, ViewPatterns, FlexibleContexts, ScopedTypeVariables, KindSignatures, TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module System.PortAudio(
  -- * Initialization
  withPortAudio
  , Error(..)
  -- * Devices
  , getDevices
  , Device(..)
  , Input
  , Output
  -- * Opening a stream
  , Stream
  , withStream
  , StreamCallbackResult(..)
  , startStream
  , stopStream
  , withStartStream
  , isStreamStopped
  , setStreamFinishedCallback
  -- * Stream parameters
  , StreamParameters
  , streamParameters
  , PortAudioSample
  , noConnection
  -- * Timestamps and status flags
  , Status(..)
  -- * Stream flags
  , StreamFlags
  , clipOff
  , ditherOff
  , neverDropInput
  , primeOutputBuffersUsingStreamCallback
  ) where

import Bindings.PortAudio
import Foreign.C.Types
import Foreign.C.String
import Foreign
import Control.Monad
import Control.Exception
import Data.Typeable
import qualified Data.Vector.Storable as V
import qualified Data.Vector.Storable.Mutable as MV
import Data.Foldable as F
#if !MIN_VERSION_base(4,8,0)
import Data.Int
import Data.Word
import Data.Proxy
#endif

data Error = NotInitialized
  | UnanticipatedHostError
  | InvalidChannelCount
  | InvalidSampleRate
  | InvalidDevice
  | InvalidFlag
  | SampleFormatNotSupported
  | BadIODeviceCombination
  | InsufficientMemory
  | BufferTooBig
  | BufferTooSmall
  | NullCallback
  | BadStreamPtr
  | TimedOut
  | InternalError
  | DeviceUnavailable
  | IncompatibleHostApiSpecificStreamInfo
  | StreamIsStopped
  | StreamIsNotStopped
  | InputOverflowed
  | OutputUnderflowed
  | HostApiNotFound
  | InvalidHostApi
  | CanNotReadFromACallbackStream
  | CanNotWriteToACallbackStream
  | CanNotReadFromAnOutputOnlyStream
  | CanNotWriteToAnInputOnlyStream
  | IncompatibleStreamHostApi
  | BadBufferPtr
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Eq Error
Eq Error
-> (Error -> Error -> Ordering)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Error)
-> (Error -> Error -> Error)
-> Ord Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmax :: Error -> Error -> Error
>= :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c< :: Error -> Error -> Bool
compare :: Error -> Error -> Ordering
$ccompare :: Error -> Error -> Ordering
$cp1Ord :: Eq Error
Ord, Int -> Error
Error -> Int
Error -> [Error]
Error -> Error
Error -> Error -> [Error]
Error -> Error -> Error -> [Error]
(Error -> Error)
-> (Error -> Error)
-> (Int -> Error)
-> (Error -> Int)
-> (Error -> [Error])
-> (Error -> Error -> [Error])
-> (Error -> Error -> [Error])
-> (Error -> Error -> Error -> [Error])
-> Enum Error
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Error -> Error -> Error -> [Error]
$cenumFromThenTo :: Error -> Error -> Error -> [Error]
enumFromTo :: Error -> Error -> [Error]
$cenumFromTo :: Error -> Error -> [Error]
enumFromThen :: Error -> Error -> [Error]
$cenumFromThen :: Error -> Error -> [Error]
enumFrom :: Error -> [Error]
$cenumFrom :: Error -> [Error]
fromEnum :: Error -> Int
$cfromEnum :: Error -> Int
toEnum :: Int -> Error
$ctoEnum :: Int -> Error
pred :: Error -> Error
$cpred :: Error -> Error
succ :: Error -> Error
$csucc :: Error -> Error
Enum, Typeable)

instance Exception Error

fromErrorCode :: CInt -> Error
fromErrorCode :: CInt -> Error
fromErrorCode CInt
n = Int -> Error
forall a. Enum a => Int -> a
toEnum (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10000)

data Device t = Device {
  Device t -> CInt
deviceIndex :: CInt
  , Device t -> String
deviceName :: String
  , Device t -> Int
deviceMaxChannels :: Int
  , Device t -> Double
deviceLowLatency :: Double
  , Device t -> Double
deviceHighLatency :: Double
  , Device t -> Double
deviceDefaultSampleRate :: Double
  } deriving (Int -> Device t -> ShowS
[Device t] -> ShowS
Device t -> String
(Int -> Device t -> ShowS)
-> (Device t -> String) -> ([Device t] -> ShowS) -> Show (Device t)
forall t. Int -> Device t -> ShowS
forall t. [Device t] -> ShowS
forall t. Device t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Device t] -> ShowS
$cshowList :: forall t. [Device t] -> ShowS
show :: Device t -> String
$cshow :: forall t. Device t -> String
showsPrec :: Int -> Device t -> ShowS
$cshowsPrec :: forall t. Int -> Device t -> ShowS
Show, Device t -> Device t -> Bool
(Device t -> Device t -> Bool)
-> (Device t -> Device t -> Bool) -> Eq (Device t)
forall t. Device t -> Device t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Device t -> Device t -> Bool
$c/= :: forall t. Device t -> Device t -> Bool
== :: Device t -> Device t -> Bool
$c== :: forall t. Device t -> Device t -> Bool
Eq, Eq (Device t)
Eq (Device t)
-> (Device t -> Device t -> Ordering)
-> (Device t -> Device t -> Bool)
-> (Device t -> Device t -> Bool)
-> (Device t -> Device t -> Bool)
-> (Device t -> Device t -> Bool)
-> (Device t -> Device t -> Device t)
-> (Device t -> Device t -> Device t)
-> Ord (Device t)
Device t -> Device t -> Bool
Device t -> Device t -> Ordering
Device t -> Device t -> Device t
forall t. Eq (Device t)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Device t -> Device t -> Bool
forall t. Device t -> Device t -> Ordering
forall t. Device t -> Device t -> Device t
min :: Device t -> Device t -> Device t
$cmin :: forall t. Device t -> Device t -> Device t
max :: Device t -> Device t -> Device t
$cmax :: forall t. Device t -> Device t -> Device t
>= :: Device t -> Device t -> Bool
$c>= :: forall t. Device t -> Device t -> Bool
> :: Device t -> Device t -> Bool
$c> :: forall t. Device t -> Device t -> Bool
<= :: Device t -> Device t -> Bool
$c<= :: forall t. Device t -> Device t -> Bool
< :: Device t -> Device t -> Bool
$c< :: forall t. Device t -> Device t -> Bool
compare :: Device t -> Device t -> Ordering
$ccompare :: forall t. Device t -> Device t -> Ordering
$cp1Ord :: forall t. Eq (Device t)
Ord)

data Input
data Output

getDevices :: IO ([Device Input], [Device Output])
getDevices :: IO ([Device Input], [Device Output])
getDevices = do
  CInt
n <- IO CInt
c'Pa_GetDeviceCount
  (([Device Input], [Device Output])
 -> CInt -> IO ([Device Input], [Device Output]))
-> ([Device Input], [Device Output])
-> [CInt]
-> IO ([Device Input], [Device Output])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Device Input], [Device Output])
-> CInt -> IO ([Device Input], [Device Output])
forall t t.
([Device t], [Device t]) -> CInt -> IO ([Device t], [Device t])
addDevice ([], []) [CInt
0..CInt
nCInt -> CInt -> CInt
forall a. Num a => a -> a -> a
-CInt
1]
  where
    addDevice :: ([Device t], [Device t]) -> CInt -> IO ([Device t], [Device t])
addDevice ([Device t]
xs, [Device t]
ys) CInt
i = do
      C'PaDeviceInfo
info <- CInt -> IO (Ptr C'PaDeviceInfo)
c'Pa_GetDeviceInfo CInt
i IO (Ptr C'PaDeviceInfo)
-> (Ptr C'PaDeviceInfo -> IO C'PaDeviceInfo) -> IO C'PaDeviceInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr C'PaDeviceInfo -> IO C'PaDeviceInfo
forall a. Storable a => Ptr a -> IO a
peek
      String
name <- CString -> IO String
peekCAString (CString -> IO String) -> CString -> IO String
forall a b. (a -> b) -> a -> b
$ C'PaDeviceInfo -> CString
c'PaDeviceInfo'name C'PaDeviceInfo
info
      let chi :: CInt
chi = C'PaDeviceInfo -> CInt
c'PaDeviceInfo'maxInputChannels C'PaDeviceInfo
info
      let cho :: CInt
cho = C'PaDeviceInfo -> CInt
c'PaDeviceInfo'maxOutputChannels C'PaDeviceInfo
info
      ([Device t], [Device t]) -> IO ([Device t], [Device t])
forall (m :: * -> *) a. Monad m => a -> m a
return (if CInt
chi CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0
        then CInt -> String -> Int -> Double -> Double -> Double -> Device t
forall t.
CInt -> String -> Int -> Double -> Double -> Double -> Device t
Device CInt
i String
name (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
chi)
          (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ C'PaDeviceInfo -> CDouble
c'PaDeviceInfo'defaultLowInputLatency C'PaDeviceInfo
info)
          (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ C'PaDeviceInfo -> CDouble
c'PaDeviceInfo'defaultHighInputLatency C'PaDeviceInfo
info)
          (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ C'PaDeviceInfo -> CDouble
c'PaDeviceInfo'defaultSampleRate C'PaDeviceInfo
info) Device t -> [Device t] -> [Device t]
forall a. a -> [a] -> [a]
: [Device t]
xs
        else [Device t]
xs
        , if CInt
cho CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0
          then CInt -> String -> Int -> Double -> Double -> Double -> Device t
forall t.
CInt -> String -> Int -> Double -> Double -> Double -> Device t
Device CInt
i String
name (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cho)
            (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ C'PaDeviceInfo -> CDouble
c'PaDeviceInfo'defaultLowOutputLatency C'PaDeviceInfo
info)
            (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ C'PaDeviceInfo -> CDouble
c'PaDeviceInfo'defaultHighOutputLatency C'PaDeviceInfo
info)
            (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ C'PaDeviceInfo -> CDouble
c'PaDeviceInfo'defaultSampleRate C'PaDeviceInfo
info) Device t -> [Device t] -> [Device t]
forall a. a -> [a] -> [a]
: [Device t]
ys
          else [Device t]
ys)

class PortAudioSample a where
  paSampleFormat :: proxy a -> CULong

instance PortAudioSample Float where
  paSampleFormat :: proxy Float -> CULong
paSampleFormat proxy Float
_ = CULong
1

instance PortAudioSample Int32 where
  paSampleFormat :: proxy Int32 -> CULong
paSampleFormat proxy Int32
_ = CULong
2

instance PortAudioSample Int16 where
  paSampleFormat :: proxy Int16 -> CULong
paSampleFormat proxy Int16
_ = CULong
8

instance PortAudioSample Int8 where
  paSampleFormat :: proxy Int8 -> CULong
paSampleFormat proxy Int8
_ = CULong
16

instance PortAudioSample Word8 where
  paSampleFormat :: proxy Word8 -> CULong
paSampleFormat proxy Word8
_ = CULong
32

newtype StreamParameters t a = StreamParameters C'PaStreamParameters deriving Ptr b -> Int -> IO (StreamParameters t a)
Ptr b -> Int -> StreamParameters t a -> IO ()
Ptr (StreamParameters t a) -> IO (StreamParameters t a)
Ptr (StreamParameters t a) -> Int -> IO (StreamParameters t a)
Ptr (StreamParameters t a) -> Int -> StreamParameters t a -> IO ()
Ptr (StreamParameters t a) -> StreamParameters t a -> IO ()
StreamParameters t a -> Int
(StreamParameters t a -> Int)
-> (StreamParameters t a -> Int)
-> (Ptr (StreamParameters t a) -> Int -> IO (StreamParameters t a))
-> (Ptr (StreamParameters t a)
    -> Int -> StreamParameters t a -> IO ())
-> (forall b. Ptr b -> Int -> IO (StreamParameters t a))
-> (forall b. Ptr b -> Int -> StreamParameters t a -> IO ())
-> (Ptr (StreamParameters t a) -> IO (StreamParameters t a))
-> (Ptr (StreamParameters t a) -> StreamParameters t a -> IO ())
-> Storable (StreamParameters t a)
forall b. Ptr b -> Int -> IO (StreamParameters t a)
forall b. Ptr b -> Int -> StreamParameters t a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall t a. Ptr (StreamParameters t a) -> IO (StreamParameters t a)
forall t a.
Ptr (StreamParameters t a) -> Int -> IO (StreamParameters t a)
forall t a.
Ptr (StreamParameters t a) -> Int -> StreamParameters t a -> IO ()
forall t a.
Ptr (StreamParameters t a) -> StreamParameters t a -> IO ()
forall t a. StreamParameters t a -> Int
forall t a b. Ptr b -> Int -> IO (StreamParameters t a)
forall t a b. Ptr b -> Int -> StreamParameters t a -> IO ()
poke :: Ptr (StreamParameters t a) -> StreamParameters t a -> IO ()
$cpoke :: forall t a.
Ptr (StreamParameters t a) -> StreamParameters t a -> IO ()
peek :: Ptr (StreamParameters t a) -> IO (StreamParameters t a)
$cpeek :: forall t a. Ptr (StreamParameters t a) -> IO (StreamParameters t a)
pokeByteOff :: Ptr b -> Int -> StreamParameters t a -> IO ()
$cpokeByteOff :: forall t a b. Ptr b -> Int -> StreamParameters t a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (StreamParameters t a)
$cpeekByteOff :: forall t a b. Ptr b -> Int -> IO (StreamParameters t a)
pokeElemOff :: Ptr (StreamParameters t a) -> Int -> StreamParameters t a -> IO ()
$cpokeElemOff :: forall t a.
Ptr (StreamParameters t a) -> Int -> StreamParameters t a -> IO ()
peekElemOff :: Ptr (StreamParameters t a) -> Int -> IO (StreamParameters t a)
$cpeekElemOff :: forall t a.
Ptr (StreamParameters t a) -> Int -> IO (StreamParameters t a)
alignment :: StreamParameters t a -> Int
$calignment :: forall t a. StreamParameters t a -> Int
sizeOf :: StreamParameters t a -> Int
$csizeOf :: forall t a. StreamParameters t a -> Int
Storable

streamParameters :: forall t f a. (Applicative f, Foldable f, PortAudioSample a)
  => Device t
  -> Double
  -> Maybe (StreamParameters t (f a))
streamParameters :: Device t -> Double -> Maybe (StreamParameters t (f a))
streamParameters Device t
dev Double
t
  | CInt
n CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Device t -> Int
forall t. Device t -> Int
deviceMaxChannels Device t
dev) = Maybe (StreamParameters t (f a))
forall a. Maybe a
Nothing
  | Bool
otherwise = StreamParameters t (f a) -> Maybe (StreamParameters t (f a))
forall a. a -> Maybe a
Just (StreamParameters t (f a) -> Maybe (StreamParameters t (f a)))
-> StreamParameters t (f a) -> Maybe (StreamParameters t (f a))
forall a b. (a -> b) -> a -> b
$ C'PaStreamParameters -> StreamParameters t (f a)
forall t a. C'PaStreamParameters -> StreamParameters t a
StreamParameters (C'PaStreamParameters -> StreamParameters t (f a))
-> C'PaStreamParameters -> StreamParameters t (f a)
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CULong -> CDouble -> Ptr () -> C'PaStreamParameters
C'PaStreamParameters
    (Device t -> CInt
forall t. Device t -> CInt
deviceIndex Device t
dev)
    CInt
n
    (Proxy a -> CULong
forall a (proxy :: * -> *). PortAudioSample a => proxy a -> CULong
paSampleFormat (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
    (Double -> CDouble
CDouble Double
t)
    Ptr ()
forall a. Ptr a
nullPtr
  where
    n :: CInt
n = f CInt -> CInt
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
F.sum (CInt -> f CInt
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
1 :: f CInt)

newtype StreamFlags = StreamFlags CULong

instance Semigroup StreamFlags where
  StreamFlags CULong
a <> :: StreamFlags -> StreamFlags -> StreamFlags
<> StreamFlags CULong
b = CULong -> StreamFlags
StreamFlags (CULong
a CULong -> CULong -> CULong
forall a. Bits a => a -> a -> a
.|. CULong
b)

instance Monoid StreamFlags where
  mempty :: StreamFlags
mempty = CULong -> StreamFlags
StreamFlags CULong
0

clipOff :: StreamFlags
clipOff :: StreamFlags
clipOff = CULong -> StreamFlags
StreamFlags CULong
0x00000001

ditherOff :: StreamFlags
ditherOff :: StreamFlags
ditherOff = CULong -> StreamFlags
StreamFlags CULong
0x00000002

neverDropInput :: StreamFlags
neverDropInput :: StreamFlags
neverDropInput = CULong -> StreamFlags
StreamFlags CULong
0x00000004

primeOutputBuffersUsingStreamCallback :: StreamFlags
primeOutputBuffersUsingStreamCallback :: StreamFlags
primeOutputBuffersUsingStreamCallback = CULong -> StreamFlags
StreamFlags CULong
0x00000008

wrap :: IO CInt -> IO ()
wrap :: IO CInt -> IO ()
wrap IO CInt
n = do
  CInt
r <- IO CInt
n
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Error -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> Error
fromErrorCode CInt
r

withPortAudio :: IO a -> IO a
withPortAudio :: IO a -> IO a
withPortAudio = IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (IO CInt -> IO ()
wrap IO CInt
c'Pa_Initialize) (IO CInt -> IO ()
wrap IO CInt
c'Pa_Terminate)

data StreamCallbackResult = Continue | Complete | Abort deriving (Int -> StreamCallbackResult -> ShowS
[StreamCallbackResult] -> ShowS
StreamCallbackResult -> String
(Int -> StreamCallbackResult -> ShowS)
-> (StreamCallbackResult -> String)
-> ([StreamCallbackResult] -> ShowS)
-> Show StreamCallbackResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamCallbackResult] -> ShowS
$cshowList :: [StreamCallbackResult] -> ShowS
show :: StreamCallbackResult -> String
$cshow :: StreamCallbackResult -> String
showsPrec :: Int -> StreamCallbackResult -> ShowS
$cshowsPrec :: Int -> StreamCallbackResult -> ShowS
Show, StreamCallbackResult -> StreamCallbackResult -> Bool
(StreamCallbackResult -> StreamCallbackResult -> Bool)
-> (StreamCallbackResult -> StreamCallbackResult -> Bool)
-> Eq StreamCallbackResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamCallbackResult -> StreamCallbackResult -> Bool
$c/= :: StreamCallbackResult -> StreamCallbackResult -> Bool
== :: StreamCallbackResult -> StreamCallbackResult -> Bool
$c== :: StreamCallbackResult -> StreamCallbackResult -> Bool
Eq, Eq StreamCallbackResult
Eq StreamCallbackResult
-> (StreamCallbackResult -> StreamCallbackResult -> Ordering)
-> (StreamCallbackResult -> StreamCallbackResult -> Bool)
-> (StreamCallbackResult -> StreamCallbackResult -> Bool)
-> (StreamCallbackResult -> StreamCallbackResult -> Bool)
-> (StreamCallbackResult -> StreamCallbackResult -> Bool)
-> (StreamCallbackResult
    -> StreamCallbackResult -> StreamCallbackResult)
-> (StreamCallbackResult
    -> StreamCallbackResult -> StreamCallbackResult)
-> Ord StreamCallbackResult
StreamCallbackResult -> StreamCallbackResult -> Bool
StreamCallbackResult -> StreamCallbackResult -> Ordering
StreamCallbackResult
-> StreamCallbackResult -> StreamCallbackResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StreamCallbackResult
-> StreamCallbackResult -> StreamCallbackResult
$cmin :: StreamCallbackResult
-> StreamCallbackResult -> StreamCallbackResult
max :: StreamCallbackResult
-> StreamCallbackResult -> StreamCallbackResult
$cmax :: StreamCallbackResult
-> StreamCallbackResult -> StreamCallbackResult
>= :: StreamCallbackResult -> StreamCallbackResult -> Bool
$c>= :: StreamCallbackResult -> StreamCallbackResult -> Bool
> :: StreamCallbackResult -> StreamCallbackResult -> Bool
$c> :: StreamCallbackResult -> StreamCallbackResult -> Bool
<= :: StreamCallbackResult -> StreamCallbackResult -> Bool
$c<= :: StreamCallbackResult -> StreamCallbackResult -> Bool
< :: StreamCallbackResult -> StreamCallbackResult -> Bool
$c< :: StreamCallbackResult -> StreamCallbackResult -> Bool
compare :: StreamCallbackResult -> StreamCallbackResult -> Ordering
$ccompare :: StreamCallbackResult -> StreamCallbackResult -> Ordering
$cp1Ord :: Eq StreamCallbackResult
Ord, Int -> StreamCallbackResult
StreamCallbackResult -> Int
StreamCallbackResult -> [StreamCallbackResult]
StreamCallbackResult -> StreamCallbackResult
StreamCallbackResult
-> StreamCallbackResult -> [StreamCallbackResult]
StreamCallbackResult
-> StreamCallbackResult
-> StreamCallbackResult
-> [StreamCallbackResult]
(StreamCallbackResult -> StreamCallbackResult)
-> (StreamCallbackResult -> StreamCallbackResult)
-> (Int -> StreamCallbackResult)
-> (StreamCallbackResult -> Int)
-> (StreamCallbackResult -> [StreamCallbackResult])
-> (StreamCallbackResult
    -> StreamCallbackResult -> [StreamCallbackResult])
-> (StreamCallbackResult
    -> StreamCallbackResult -> [StreamCallbackResult])
-> (StreamCallbackResult
    -> StreamCallbackResult
    -> StreamCallbackResult
    -> [StreamCallbackResult])
-> Enum StreamCallbackResult
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StreamCallbackResult
-> StreamCallbackResult
-> StreamCallbackResult
-> [StreamCallbackResult]
$cenumFromThenTo :: StreamCallbackResult
-> StreamCallbackResult
-> StreamCallbackResult
-> [StreamCallbackResult]
enumFromTo :: StreamCallbackResult
-> StreamCallbackResult -> [StreamCallbackResult]
$cenumFromTo :: StreamCallbackResult
-> StreamCallbackResult -> [StreamCallbackResult]
enumFromThen :: StreamCallbackResult
-> StreamCallbackResult -> [StreamCallbackResult]
$cenumFromThen :: StreamCallbackResult
-> StreamCallbackResult -> [StreamCallbackResult]
enumFrom :: StreamCallbackResult -> [StreamCallbackResult]
$cenumFrom :: StreamCallbackResult -> [StreamCallbackResult]
fromEnum :: StreamCallbackResult -> Int
$cfromEnum :: StreamCallbackResult -> Int
toEnum :: Int -> StreamCallbackResult
$ctoEnum :: Int -> StreamCallbackResult
pred :: StreamCallbackResult -> StreamCallbackResult
$cpred :: StreamCallbackResult -> StreamCallbackResult
succ :: StreamCallbackResult -> StreamCallbackResult
$csucc :: StreamCallbackResult -> StreamCallbackResult
Enum)

instance Semigroup StreamCallbackResult where
  StreamCallbackResult
Complete <> :: StreamCallbackResult
-> StreamCallbackResult -> StreamCallbackResult
<> StreamCallbackResult
x = StreamCallbackResult
x
  StreamCallbackResult
x <> StreamCallbackResult
Complete = StreamCallbackResult
x
  StreamCallbackResult
Abort <> StreamCallbackResult
_ = StreamCallbackResult
Abort
  StreamCallbackResult
_ <> StreamCallbackResult
Abort = StreamCallbackResult
Abort
  StreamCallbackResult
Continue <> StreamCallbackResult
Continue = StreamCallbackResult
Continue

instance Monoid StreamCallbackResult where
  mempty :: StreamCallbackResult
mempty = StreamCallbackResult
Complete

data Status = Status
  { Status -> Double
currentTime :: !Double
  , Status -> Double
inputBufferAdcTime :: !Double
  , Status -> Double
outputBufferDacTime :: !Double
  , Status -> Bool
inputUnderflow :: !Bool
  , Status -> Bool
inputOverflow :: !Bool
  , Status -> Bool
outputUnderflow :: !Bool
  , Status -> Bool
outputOverflow :: !Bool
  , Status -> Bool
primingOutput :: !Bool } deriving (Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show, Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Eq Status
Eq Status
-> (Status -> Status -> Ordering)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Status)
-> (Status -> Status -> Status)
-> Ord Status
Status -> Status -> Bool
Status -> Status -> Ordering
Status -> Status -> Status
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmax :: Status -> Status -> Status
>= :: Status -> Status -> Bool
$c>= :: Status -> Status -> Bool
> :: Status -> Status -> Bool
$c> :: Status -> Status -> Bool
<= :: Status -> Status -> Bool
$c<= :: Status -> Status -> Bool
< :: Status -> Status -> Bool
$c< :: Status -> Status -> Bool
compare :: Status -> Status -> Ordering
$ccompare :: Status -> Status -> Ordering
$cp1Ord :: Eq Status
Ord)

newtype Stream = Stream { Stream -> Ptr ()
unStream :: Ptr C'PaStream }

withStream :: (Storable i, Storable o)
  => Double -- ^ sampling rate
  -> Int -- ^ buffer size
  -> Maybe (StreamParameters Input i)
  -> Maybe (StreamParameters Output o)
  -> StreamFlags
  -> (Status -> V.Vector i -> MV.IOVector o -> IO StreamCallbackResult) -- ^ callback
  -> (Stream -> IO r)
  -> IO r
withStream :: Double
-> Int
-> Maybe (StreamParameters Input i)
-> Maybe (StreamParameters Output o)
-> StreamFlags
-> (Status -> Vector i -> IOVector o -> IO StreamCallbackResult)
-> (Stream -> IO r)
-> IO r
withStream Double
rate Int
buf Maybe (StreamParameters Input i)
paramI Maybe (StreamParameters Output o)
paramO (StreamFlags CULong
flags) Status -> Vector i -> IOVector o -> IO StreamCallbackResult
f Stream -> IO r
m =
  Maybe (StreamParameters Input i)
-> (Ptr (StreamParameters Input i) -> IO r) -> IO r
forall a b. Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe Maybe (StreamParameters Input i)
paramI ((Ptr (StreamParameters Input i) -> IO r) -> IO r)
-> (Ptr (StreamParameters Input i) -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr (StreamParameters Input i)
pin -> Maybe (StreamParameters Output o)
-> (Ptr (StreamParameters Output o) -> IO r) -> IO r
forall a b. Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe Maybe (StreamParameters Output o)
paramO ((Ptr (StreamParameters Output o) -> IO r) -> IO r)
-> (Ptr (StreamParameters Output o) -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr (StreamParameters Output o)
pout -> do
    C'PaStreamCallback
cb <- (Ptr ()
 -> Ptr ()
 -> CULong
 -> Ptr C'PaStreamCallbackTimeInfo
 -> CULong
 -> Ptr ()
 -> IO C'PaStreamCallbackResult)
-> IO C'PaStreamCallback
mk'PaStreamCallback ((Ptr ()
  -> Ptr ()
  -> CULong
  -> Ptr C'PaStreamCallbackTimeInfo
  -> CULong
  -> Ptr ()
  -> IO C'PaStreamCallbackResult)
 -> IO C'PaStreamCallback)
-> (Ptr ()
    -> Ptr ()
    -> CULong
    -> Ptr C'PaStreamCallbackTimeInfo
    -> CULong
    -> Ptr ()
    -> IO C'PaStreamCallbackResult)
-> IO C'PaStreamCallback
forall a b. (a -> b) -> a -> b
$ (Status -> Vector i -> IOVector o -> IO StreamCallbackResult)
-> Ptr ()
-> Ptr ()
-> CULong
-> Ptr C'PaStreamCallbackTimeInfo
-> CULong
-> Ptr ()
-> IO C'PaStreamCallbackResult
forall a b z.
(Storable a, Storable b) =>
(Status -> Vector a -> IOVector b -> IO StreamCallbackResult)
-> Ptr ()
-> Ptr ()
-> CULong
-> Ptr C'PaStreamCallbackTimeInfo
-> CULong
-> z
-> IO C'PaStreamCallbackResult
callback Status -> Vector i -> IOVector o -> IO StreamCallbackResult
f
    let opener :: Ptr (Ptr ()) -> IO (Ptr ())
opener Ptr (Ptr ())
ps = do
          IO CInt -> IO ()
wrap (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ())
-> Ptr C'PaStreamParameters
-> Ptr C'PaStreamParameters
-> CDouble
-> CULong
-> CULong
-> C'PaStreamCallback
-> Ptr ()
-> IO CInt
c'Pa_OpenStream Ptr (Ptr ())
ps
              (Ptr (StreamParameters Input i) -> Ptr C'PaStreamParameters
forall a b. Ptr a -> Ptr b
castPtr Ptr (StreamParameters Input i)
pin)
              (Ptr (StreamParameters Output o) -> Ptr C'PaStreamParameters
forall a b. Ptr a -> Ptr b
castPtr Ptr (StreamParameters Output o)
pout)
              (Double -> CDouble
CDouble Double
rate)
              (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
buf)
              CULong
flags
              C'PaStreamCallback
cb
              Ptr ()
forall a. Ptr a
nullPtr
          Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
ps
    (Ptr (Ptr ()) -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO r) -> IO r) -> (Ptr (Ptr ()) -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
ps -> IO (Ptr ()) -> (Ptr () -> IO ()) -> (Ptr () -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Ptr (Ptr ()) -> IO (Ptr ())
opener Ptr (Ptr ())
ps) (IO CInt -> IO ()
wrap (IO CInt -> IO ()) -> (Ptr () -> IO CInt) -> Ptr () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO CInt
c'Pa_CloseStream) ((Ptr () -> IO r) -> IO r) -> (Ptr () -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ Stream -> IO r
m (Stream -> IO r) -> (Ptr () -> Stream) -> Ptr () -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> Stream
Stream

startStream :: Stream -> IO ()
startStream :: Stream -> IO ()
startStream = IO CInt -> IO ()
wrap (IO CInt -> IO ()) -> (Stream -> IO CInt) -> Stream -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO CInt
c'Pa_StartStream (Ptr () -> IO CInt) -> (Stream -> Ptr ()) -> Stream -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream -> Ptr ()
unStream

stopStream :: Stream -> IO ()
stopStream :: Stream -> IO ()
stopStream = IO CInt -> IO ()
wrap (IO CInt -> IO ()) -> (Stream -> IO CInt) -> Stream -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO CInt
c'Pa_StopStream (Ptr () -> IO CInt) -> (Stream -> Ptr ()) -> Stream -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream -> Ptr ()
unStream

setStreamFinishedCallback :: Stream -> IO () -> IO ()
setStreamFinishedCallback :: Stream -> IO () -> IO ()
setStreamFinishedCallback (Stream Ptr ()
s) IO ()
m = do
  C'PaStreamFinishedCallback
cb <- (Ptr () -> IO ()) -> IO C'PaStreamFinishedCallback
mk'PaStreamFinishedCallback (IO () -> Ptr () -> IO ()
forall a b. a -> b -> a
const IO ()
m)
  IO CInt -> IO ()
wrap (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr () -> C'PaStreamFinishedCallback -> IO CInt
c'Pa_SetStreamFinishedCallback Ptr ()
s C'PaStreamFinishedCallback
cb

isStreamStopped :: Stream -> IO Bool
isStreamStopped :: Stream -> IO Bool
isStreamStopped = (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
==CInt
1) (IO CInt -> IO Bool) -> (Stream -> IO CInt) -> Stream -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO CInt
c'Pa_IsStreamStopped (Ptr () -> IO CInt) -> (Stream -> Ptr ()) -> Stream -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream -> Ptr ()
unStream

withStartStream :: Stream -> IO r -> IO r
withStartStream :: Stream -> IO r -> IO r
withStartStream Stream
s = IO () -> IO () -> IO r -> IO r
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (Stream -> IO ()
startStream Stream
s) (Stream -> IO ()
stopStream Stream
s)

-- | This is 'Nothing', but it explicitly specifies the stream type with zero-width unit type.
noConnection :: Maybe (StreamParameters t ())
noConnection :: Maybe (StreamParameters t ())
noConnection = Maybe (StreamParameters t ())
forall a. Maybe a
Nothing

callback :: (Storable a, Storable b) => (Status -> V.Vector a -> MV.IOVector b -> IO StreamCallbackResult) -> Ptr () -> Ptr () -> CULong -> Ptr C'PaStreamCallbackTimeInfo -> CULong -> z -> IO CUInt
callback :: (Status -> Vector a -> IOVector b -> IO StreamCallbackResult)
-> Ptr ()
-> Ptr ()
-> CULong
-> Ptr C'PaStreamCallbackTimeInfo
-> CULong
-> z
-> IO C'PaStreamCallbackResult
callback Status -> Vector a -> IOVector b -> IO StreamCallbackResult
f (Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr -> Ptr a
pin) (Ptr () -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr -> Ptr b
pout) (CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n) Ptr C'PaStreamCallbackTimeInfo
pinfo CULong
flags z
_ = do
  ForeignPtr a
ip <- Ptr a -> IO (ForeignPtr a)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr a
pin
  ForeignPtr b
op <- Ptr b -> IO (ForeignPtr b)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr b
pout
  C'PaStreamCallbackTimeInfo
info <- Ptr C'PaStreamCallbackTimeInfo -> IO C'PaStreamCallbackTimeInfo
forall a. Storable a => Ptr a -> IO a
peek Ptr C'PaStreamCallbackTimeInfo
pinfo
  (StreamCallbackResult -> C'PaStreamCallbackResult)
-> IO StreamCallbackResult -> IO C'PaStreamCallbackResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> C'PaStreamCallbackResult
forall a. Enum a => Int -> a
toEnum (Int -> C'PaStreamCallbackResult)
-> (StreamCallbackResult -> Int)
-> StreamCallbackResult
-> C'PaStreamCallbackResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamCallbackResult -> Int
forall a. Enum a => a -> Int
fromEnum) (IO StreamCallbackResult -> IO C'PaStreamCallbackResult)
-> IO StreamCallbackResult -> IO C'PaStreamCallbackResult
forall a b. (a -> b) -> a -> b
$ Status -> Vector a -> IOVector b -> IO StreamCallbackResult
f (Double
-> Double
-> Double
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Status
Status (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ C'PaStreamCallbackTimeInfo -> CDouble
c'PaStreamCallbackTimeInfo'currentTime C'PaStreamCallbackTimeInfo
info)
      (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ C'PaStreamCallbackTimeInfo -> CDouble
c'PaStreamCallbackTimeInfo'inputBufferAdcTime C'PaStreamCallbackTimeInfo
info)
      (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ C'PaStreamCallbackTimeInfo -> CDouble
c'PaStreamCallbackTimeInfo'outputBufferDacTime C'PaStreamCallbackTimeInfo
info)
      (CULong -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit CULong
flags Int
0)
      (CULong -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit CULong
flags Int
1)
      (CULong -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit CULong
flags Int
2)
      (CULong -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit CULong
flags Int
3)
      (CULong -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit CULong
flags Int
4))
    (ForeignPtr a -> Int -> Vector a
forall a. Storable a => ForeignPtr a -> Int -> Vector a
V.unsafeFromForeignPtr0 ForeignPtr a
ip Int
n)
    (ForeignPtr b -> Int -> IOVector b
forall a s. Storable a => ForeignPtr a -> Int -> MVector s a
MV.unsafeFromForeignPtr0 ForeignPtr b
op Int
n)

withMaybe :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe :: Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe Maybe a
Nothing Ptr a -> IO b
c = Ptr a -> IO b
c Ptr a
forall a. Ptr a
nullPtr
withMaybe (Just a
a) Ptr a -> IO b
c = a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
a Ptr a -> IO b
c