{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Copyright: (c) 2021 Tristan de Cacqueray
-- SPDX-License-Identifier: Apache-2.0
-- Maintainer: Tristan de Cacqueray <tdecacqu@redhat.com>
--
-- Pipes for simple-pulse audio
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

-- | Return the bits count of a single sample
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

-- | Return the bits count of an one second buffer
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

-- | Compute the sample spec and buffer size for a given fps
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

-- | Create an audio pipe producer that yields `fps` bytestring buffer per second
readPulse ::
  MonadSafe m =>
  -- | The client name
  String ->
  -- | The sample spec, default to mono 44100 Hz 16 bit signed integer
  Maybe SampleSpec ->
  -- | Frames per second
  Int ->
  -- | The pipe producing bytestring
  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 #-}

-- | Create an audio pipe consumer that awaits `fps` bytestring buffer per second
writePulse ::
  MonadSafe m =>
  -- | The client name
  String ->
  -- | The sample spec, default to mono 44100 Hz 16 bit signed integer
  Maybe SampleSpec ->
  -- | Frames per second
  Int ->
  -- | The pipe consuming bytestring
  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 #-}