{-# LANGUAGE ForeignFunctionInterface #-}
module Sound.OpusFile
( Handle(..)
, OggOpusFile
, openMemoryBS
, openMemory
, free
, Channels(..)
, channelCount
, pcmTotal
, Pcm(..)
, decodeInt16
) where
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.Int (Int16, Int64)
import Foreign (ForeignPtr, Ptr)
import Foreign.C.Types (CChar, CInt(..))
import System.IO.Unsafe (unsafePerformIO)
import qualified Foreign
newtype Handle = Handle (Ptr OggOpusFile)
deriving (Handle -> Handle -> Bool
(Handle -> Handle -> Bool)
-> (Handle -> Handle -> Bool) -> Eq Handle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Handle -> Handle -> Bool
$c/= :: Handle -> Handle -> Bool
== :: Handle -> Handle -> Bool
$c== :: Handle -> Handle -> Bool
Eq, Int -> Handle -> ShowS
[Handle] -> ShowS
Handle -> String
(Int -> Handle -> ShowS)
-> (Handle -> String) -> ([Handle] -> ShowS) -> Show Handle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Handle] -> ShowS
$cshowList :: [Handle] -> ShowS
show :: Handle -> String
$cshow :: Handle -> String
showsPrec :: Int -> Handle -> ShowS
$cshowsPrec :: Int -> Handle -> ShowS
Show)
data OggOpusFile
openMemoryBS :: ByteString -> IO (Either Int Handle)
openMemoryBS :: ByteString -> IO (Either Int Handle)
openMemoryBS ByteString
bs = ByteString
-> (CStringLen -> IO (Either Int Handle)) -> IO (Either Int Handle)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs \(Ptr CChar
dataPtr, Int
dataLen) ->
Ptr CChar -> CInt -> IO (Either Int Handle)
openMemory Ptr CChar
dataPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataLen)
openMemory :: Ptr CChar -> CInt -> IO (Either Int Handle)
openMemory :: Ptr CChar -> CInt -> IO (Either Int Handle)
openMemory Ptr CChar
dataPtr CInt
dataLen =
(Ptr CInt -> IO (Either Int Handle)) -> IO (Either Int Handle)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
Foreign.alloca \Ptr CInt
errorPtr -> do
Ptr OggOpusFile
oggOpusFile <- Ptr CChar -> CInt -> Ptr CInt -> IO (Ptr OggOpusFile)
op_test_memory Ptr CChar
dataPtr CInt
dataLen Ptr CInt
errorPtr
Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr CInt
errorPtr IO CInt
-> (CInt -> IO (Either Int Handle)) -> IO (Either Int Handle)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
CInt
0 -> do
Ptr OggOpusFile -> IO CInt
op_test_open Ptr OggOpusFile
oggOpusFile IO CInt
-> (CInt -> IO (Either Int Handle)) -> IO (Either Int Handle)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
CInt
0 ->
Either Int Handle -> IO (Either Int Handle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int Handle -> IO (Either Int Handle))
-> Either Int Handle -> IO (Either Int Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> Either Int Handle
forall a b. b -> Either a b
Right (Ptr OggOpusFile -> Handle
Handle Ptr OggOpusFile
oggOpusFile)
CInt
err ->
Either Int Handle -> IO (Either Int Handle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int Handle -> IO (Either Int Handle))
-> Either Int Handle -> IO (Either Int Handle)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int Handle
forall a b. a -> Either a b
Left (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
err)
CInt
err ->
Either Int Handle -> IO (Either Int Handle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Int Handle -> IO (Either Int Handle))
-> Either Int Handle -> IO (Either Int Handle)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int Handle
forall a b. a -> Either a b
Left (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
err)
free :: Handle -> IO ()
free :: Handle -> IO ()
free (Handle Ptr OggOpusFile
handle) = Ptr OggOpusFile -> IO ()
op_free Ptr OggOpusFile
handle
data Channels
= Mono
| Stereo
deriving (Channels -> Channels -> Bool
(Channels -> Channels -> Bool)
-> (Channels -> Channels -> Bool) -> Eq Channels
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channels -> Channels -> Bool
$c/= :: Channels -> Channels -> Bool
== :: Channels -> Channels -> Bool
$c== :: Channels -> Channels -> Bool
Eq, Eq Channels
Eq Channels
-> (Channels -> Channels -> Ordering)
-> (Channels -> Channels -> Bool)
-> (Channels -> Channels -> Bool)
-> (Channels -> Channels -> Bool)
-> (Channels -> Channels -> Bool)
-> (Channels -> Channels -> Channels)
-> (Channels -> Channels -> Channels)
-> Ord Channels
Channels -> Channels -> Bool
Channels -> Channels -> Ordering
Channels -> Channels -> Channels
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 :: Channels -> Channels -> Channels
$cmin :: Channels -> Channels -> Channels
max :: Channels -> Channels -> Channels
$cmax :: Channels -> Channels -> Channels
>= :: Channels -> Channels -> Bool
$c>= :: Channels -> Channels -> Bool
> :: Channels -> Channels -> Bool
$c> :: Channels -> Channels -> Bool
<= :: Channels -> Channels -> Bool
$c<= :: Channels -> Channels -> Bool
< :: Channels -> Channels -> Bool
$c< :: Channels -> Channels -> Bool
compare :: Channels -> Channels -> Ordering
$ccompare :: Channels -> Channels -> Ordering
$cp1Ord :: Eq Channels
Ord, Int -> Channels -> ShowS
[Channels] -> ShowS
Channels -> String
(Int -> Channels -> ShowS)
-> (Channels -> String) -> ([Channels] -> ShowS) -> Show Channels
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Channels] -> ShowS
$cshowList :: [Channels] -> ShowS
show :: Channels -> String
$cshow :: Channels -> String
showsPrec :: Int -> Channels -> ShowS
$cshowsPrec :: Int -> Channels -> ShowS
Show, Int -> Channels
Channels -> Int
Channels -> [Channels]
Channels -> Channels
Channels -> Channels -> [Channels]
Channels -> Channels -> Channels -> [Channels]
(Channels -> Channels)
-> (Channels -> Channels)
-> (Int -> Channels)
-> (Channels -> Int)
-> (Channels -> [Channels])
-> (Channels -> Channels -> [Channels])
-> (Channels -> Channels -> [Channels])
-> (Channels -> Channels -> Channels -> [Channels])
-> Enum Channels
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 :: Channels -> Channels -> Channels -> [Channels]
$cenumFromThenTo :: Channels -> Channels -> Channels -> [Channels]
enumFromTo :: Channels -> Channels -> [Channels]
$cenumFromTo :: Channels -> Channels -> [Channels]
enumFromThen :: Channels -> Channels -> [Channels]
$cenumFromThen :: Channels -> Channels -> [Channels]
enumFrom :: Channels -> [Channels]
$cenumFrom :: Channels -> [Channels]
fromEnum :: Channels -> Int
$cfromEnum :: Channels -> Int
toEnum :: Int -> Channels
$ctoEnum :: Int -> Channels
pred :: Channels -> Channels
$cpred :: Channels -> Channels
succ :: Channels -> Channels
$csucc :: Channels -> Channels
Enum, Channels
Channels -> Channels -> Bounded Channels
forall a. a -> a -> Bounded a
maxBound :: Channels
$cmaxBound :: Channels
minBound :: Channels
$cminBound :: Channels
Bounded)
channelCount :: Handle -> Either Int Channels
channelCount :: Handle -> Either Int Channels
channelCount (Handle Ptr OggOpusFile
handle) =
case IO CInt -> CInt
forall a. IO a -> a
unsafePerformIO (Ptr OggOpusFile -> CInt -> IO CInt
op_channel_count Ptr OggOpusFile
handle (-CInt
1)) of
CInt
1 -> Channels -> Either Int Channels
forall a b. b -> Either a b
Right Channels
Mono
CInt
2 -> Channels -> Either Int Channels
forall a b. b -> Either a b
Right Channels
Stereo
CInt
n -> Int -> Either Int Channels
forall a b. a -> Either a b
Left (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n)
pcmTotal :: Handle -> Either String Int
pcmTotal :: Handle -> Either String Int
pcmTotal (Handle Ptr OggOpusFile
handle) =
let
res :: Int64
res = IO Int64 -> Int64
forall a. IO a -> a
unsafePerformIO (Ptr OggOpusFile -> CInt -> IO Int64
op_pcm_total Ptr OggOpusFile
handle (-CInt
1))
in
if Int64
res Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 then
String -> Either String Int
forall a b. a -> Either a b
Left String
"OpusFile: The source is not seekable, _li wasn't less than the total number of links in the stream, or the stream was only partially open."
else
Int -> Either String Int
forall a b. b -> Either a b
Right (Int -> Either String Int) -> Int -> Either String Int
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
res
data Pcm a = Pcm
{ Pcm a -> ForeignPtr a
pcmData :: ForeignPtr a
, Pcm a -> Int
pcmSize :: Int
, Pcm a -> Double
pcmTime :: Double
, Pcm a -> Either Int Channels
pcmChannels :: Either Int Channels
}
deriving (Pcm a -> Pcm a -> Bool
(Pcm a -> Pcm a -> Bool) -> (Pcm a -> Pcm a -> Bool) -> Eq (Pcm a)
forall a. Pcm a -> Pcm a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pcm a -> Pcm a -> Bool
$c/= :: forall a. Pcm a -> Pcm a -> Bool
== :: Pcm a -> Pcm a -> Bool
$c== :: forall a. Pcm a -> Pcm a -> Bool
Eq, Int -> Pcm a -> ShowS
[Pcm a] -> ShowS
Pcm a -> String
(Int -> Pcm a -> ShowS)
-> (Pcm a -> String) -> ([Pcm a] -> ShowS) -> Show (Pcm a)
forall a. Int -> Pcm a -> ShowS
forall a. [Pcm a] -> ShowS
forall a. Pcm a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pcm a] -> ShowS
$cshowList :: forall a. [Pcm a] -> ShowS
show :: Pcm a -> String
$cshow :: forall a. Pcm a -> String
showsPrec :: Int -> Pcm a -> ShowS
$cshowsPrec :: forall a. Int -> Pcm a -> ShowS
Show)
decodeInt16 :: Handle -> IO (Pcm Int16)
decodeInt16 :: Handle -> IO (Pcm Int16)
decodeInt16 h :: Handle
h@(Handle Ptr OggOpusFile
handle) = do
Int
hPcmSize <- case Handle -> Either String Int
pcmTotal Handle
h of
Left String
err ->
String -> IO Int
forall a. HasCallStack => String -> a
error String
err
Right Int
res ->
Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
res
let
byteSize :: Int
byteSize = Int
hPcmSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numChannels Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampleBytes
ForeignPtr Int16
fptr <- Int -> IO (ForeignPtr Int16)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes Int
byteSize
ForeignPtr Int16
-> (Ptr Int16 -> IO (Either CInt Int)) -> IO (Either CInt Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr Int16
fptr (Int -> Int -> Ptr Int16 -> IO (Either CInt Int)
go Int
hPcmSize Int
0) IO (Either CInt Int)
-> (Either CInt Int -> IO (Pcm Int16)) -> IO (Pcm Int16)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left CInt
ret ->
String -> IO (Pcm Int16)
forall a. HasCallStack => String -> a
error (String -> IO (Pcm Int16)) -> String -> IO (Pcm Int16)
forall a b. (a -> b) -> a -> b
$ CInt -> String
forall a. Show a => a -> String
show CInt
ret
Right Int
_samplesDone ->
Pcm Int16 -> IO (Pcm Int16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pcm :: forall a.
ForeignPtr a -> Int -> Double -> Either Int Channels -> Pcm a
Pcm
{ pcmData :: ForeignPtr Int16
pcmData = ForeignPtr Int16
fptr
, pcmSize :: Int
pcmSize = Int
byteSize
, pcmTime :: Double
pcmTime = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hPcmSize Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
48000
, pcmChannels :: Either Int Channels
pcmChannels = Either Int Channels
hPcmChannels
}
where
hPcmChannels :: Either Int Channels
hPcmChannels = Handle -> Either Int Channels
channelCount Handle
h
numChannels :: Int
numChannels = case Either Int Channels
hPcmChannels of
Right Channels
Mono -> Int
1
Right Channels
Stereo -> Int
2
Left Int
n -> Int
n
sampleBytes :: Int
sampleBytes = Int16 -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (Int16
forall a. HasCallStack => a
undefined :: Int16)
go :: Int -> Int -> Ptr Int16 -> IO (Either CInt Int)
go Int
hPcmSize Int
samplesRead Ptr Int16
buf = do
CInt
ret <- Ptr OggOpusFile -> Ptr Int16 -> CInt -> Ptr CInt -> IO CInt
op_read
Ptr OggOpusFile
handle
Ptr Int16
buf
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
hPcmSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numChannels)
Ptr CInt
forall a. Ptr a
Foreign.nullPtr
if CInt
ret CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
Either CInt Int -> IO (Either CInt Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CInt Int -> IO (Either CInt Int))
-> Either CInt Int -> IO (Either CInt Int)
forall a b. (a -> b) -> a -> b
$ CInt -> Either CInt Int
forall a b. a -> Either a b
Left CInt
ret
else do
let samplesDone :: Int
samplesDone = Int
samplesRead Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ret
if Int
samplesDone Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hPcmSize then
Int -> Int -> Ptr Int16 -> IO (Either CInt Int)
go Int
hPcmSize Int
samplesDone (Ptr Int16 -> IO (Either CInt Int))
-> Ptr Int16 -> IO (Either CInt Int)
forall a b. (a -> b) -> a -> b
$
Ptr Int16 -> Int -> Ptr Int16
forall a b. Ptr a -> Int -> Ptr b
Foreign.plusPtr Ptr Int16
buf (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ret Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numChannels Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampleBytes)
else
Either CInt Int -> IO (Either CInt Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CInt Int -> IO (Either CInt Int))
-> Either CInt Int -> IO (Either CInt Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either CInt Int
forall a b. b -> Either a b
Right Int
samplesDone
foreign import ccall "op_free"
op_free :: Ptr OggOpusFile -> IO ()
foreign import ccall "op_test_memory"
op_test_memory :: Ptr CChar -> CInt -> Ptr CInt -> IO (Ptr OggOpusFile)
foreign import ccall "op_test_open"
op_test_open :: Ptr OggOpusFile -> IO CInt
foreign import ccall "op_channel_count"
op_channel_count :: Ptr OggOpusFile -> CInt -> IO CInt
foreign import ccall "op_pcm_total"
op_pcm_total :: Ptr OggOpusFile -> CInt -> IO Int64
foreign import ccall "op_read"
op_read
:: Ptr OggOpusFile
-> Ptr Int16
-> CInt
-> Ptr CInt
-> IO CInt