{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
module Pipes.PulseSimple
( readPulse,
writePulse,
)
where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)
import Pipes (Consumer', Producer', await, yield)
import Pipes.Safe (MonadSafe, bracket)
import Sound.Pulse.Simple
( BufferAttr (..),
Direction (..),
Endian (..),
SampleFormat (..),
SampleSpec (..),
Simple,
simpleFree,
simpleNew,
simpleReadRaw,
simpleWriteRaw,
)
defaultSampleSpec :: SampleSpec
defaultSampleSpec :: SampleSpec
defaultSampleSpec = SampleFormat -> Int -> Int -> SampleSpec
SampleSpec (Endian -> SampleFormat
S16 Endian
LittleEndian) Int
44100 Int
1
sampleSize :: SampleFormat -> Int
sampleSize :: SampleFormat -> Int
sampleSize = \case
U8 Compression
_ -> Int
1
S16 Endian
_ -> Int
2
S24 Endian
_ -> Int
3
S2432 Endian
_ -> Int
4
S32 Endian
_ -> Int
4
F32 Endian
_ -> Int
4
bufferSize :: SampleSpec -> Int
bufferSize :: SampleSpec -> Int
bufferSize (SampleSpec SampleFormat
fmt Int
sampling Int
chan) = SampleFormat -> Int
sampleSize SampleFormat
fmt Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampling Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
chan
specSize :: Maybe SampleSpec -> Int -> (SampleSpec, Int)
specSize :: Maybe SampleSpec -> Int -> (SampleSpec, Int)
specSize Maybe SampleSpec
specm Int
fps = (SampleSpec
spec, Int
size)
where
spec :: SampleSpec
spec = SampleSpec -> Maybe SampleSpec -> SampleSpec
forall a. a -> Maybe a -> a
fromMaybe SampleSpec
defaultSampleSpec Maybe SampleSpec
specm
size :: Int
size = SampleSpec -> Int
bufferSize SampleSpec
spec Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
fps
newClient :: MonadIO m => String -> Direction -> SampleSpec -> Int -> m Simple
newClient :: String -> Direction -> SampleSpec -> Int -> m Simple
newClient String
name Direction
dir SampleSpec
spec Int
size = IO Simple -> m Simple
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Simple
create
where
create :: IO Simple
create = Maybe String
-> String
-> Direction
-> Maybe String
-> String
-> SampleSpec
-> Maybe [ChannelPosition]
-> Maybe BufferAttr
-> IO Simple
simpleNew Maybe String
forall a. Maybe a
Nothing String
name Direction
dir Maybe String
forall a. Maybe a
Nothing String
"pulse-pipe" SampleSpec
spec Maybe [ChannelPosition]
forall a. Maybe a
Nothing Maybe BufferAttr
bufAttr
bufAttr :: Maybe BufferAttr
bufAttr = BufferAttr -> Maybe BufferAttr
forall a. a -> Maybe a
Just (Maybe Int
-> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> BufferAttr
BufferAttr (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
size) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
size) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
size) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
size) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
size))
freeClient :: MonadIO m => Simple -> m ()
freeClient :: Simple -> m ()
freeClient = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Simple -> IO ()) -> Simple -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Simple -> IO ()
simpleFree
readPulse ::
MonadSafe m =>
String ->
Maybe SampleSpec ->
Int ->
Producer' ByteString m ()
readPulse :: String -> Maybe SampleSpec -> Int -> Producer' ByteString m ()
readPulse String
name Maybe SampleSpec
specm Int
fps = Base (Proxy x' x () ByteString m) Simple
-> (Simple -> Base (Proxy x' x () ByteString m) ())
-> (Simple -> Proxy x' x () ByteString m ())
-> Proxy x' x () ByteString m ()
forall (m :: * -> *) a b c.
MonadSafe m =>
Base m a -> (a -> Base m b) -> (a -> m c) -> m c
bracket (String -> Direction -> SampleSpec -> Int -> Base m Simple
forall (m :: * -> *).
MonadIO m =>
String -> Direction -> SampleSpec -> Int -> m Simple
newClient String
name Direction
Record SampleSpec
spec Int
size) Simple -> Base (Proxy x' x () ByteString m) ()
forall (m :: * -> *). MonadIO m => Simple -> m ()
freeClient Simple -> Proxy x' x () ByteString m ()
forall (m :: * -> *) x' x b.
MonadIO m =>
Simple -> Proxy x' x () ByteString m b
producePulse
where
(SampleSpec
spec, Int
size) = Maybe SampleSpec -> Int -> (SampleSpec, Int)
specSize Maybe SampleSpec
specm Int
fps
producePulse :: Simple -> Proxy x' x () ByteString m b
producePulse Simple
s = do
ByteString
buf <- IO ByteString -> Proxy x' x () ByteString m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Simple -> Int -> IO ByteString
simpleReadRaw Simple
s Int
size)
ByteString -> Producer' ByteString m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield ByteString
buf
Simple -> Proxy x' x () ByteString m b
producePulse Simple
s
{-# INLINEABLE readPulse #-}
writePulse ::
MonadSafe m =>
String ->
Maybe SampleSpec ->
Int ->
Consumer' ByteString m ()
writePulse :: String -> Maybe SampleSpec -> Int -> Consumer' ByteString m ()
writePulse String
name Maybe SampleSpec
specm Int
fps = Base (Proxy () ByteString y' y m) Simple
-> (Simple -> Base (Proxy () ByteString y' y m) ())
-> (Simple -> Proxy () ByteString y' y m ())
-> Proxy () ByteString y' y m ()
forall (m :: * -> *) a b c.
MonadSafe m =>
Base m a -> (a -> Base m b) -> (a -> m c) -> m c
bracket (String -> Direction -> SampleSpec -> Int -> Base m Simple
forall (m :: * -> *).
MonadIO m =>
String -> Direction -> SampleSpec -> Int -> m Simple
newClient String
name Direction
Play SampleSpec
spec Int
size) Simple -> Base (Proxy () ByteString y' y m) ()
forall (m :: * -> *). MonadIO m => Simple -> m ()
freeClient Simple -> Proxy () ByteString y' y m ()
forall (m :: * -> *) y' y b.
MonadIO m =>
Simple -> Proxy () ByteString y' y m b
consumePulse
where
(SampleSpec
spec, Int
size) = Maybe SampleSpec -> Int -> (SampleSpec, Int)
specSize Maybe SampleSpec
specm Int
fps
consumePulse :: Simple -> Proxy () ByteString y' y m b
consumePulse Simple
s = do
ByteString
buf <- Proxy () ByteString y' y m ByteString
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
IO () -> Proxy () ByteString y' y m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Simple -> ByteString -> IO ()
simpleWriteRaw Simple
s ByteString
buf)
Simple -> Proxy () ByteString y' y m b
consumePulse Simple
s
{-# INLINEABLE writePulse #-}