{-# LINE 1 "src/Codec/FFmpeg/Probe.hsc" #-}
{-# LINE 2 "src/Codec/FFmpeg/Probe.hsc" #-}
{-# LANGUAGE
ForeignFunctionInterface,
GeneralizedNewtypeDeriving
#-}
module Codec.FFmpeg.Probe (
withAvFile, nbStreams, formatName, formatMetadata, duration,
AvStreamT, withStream, codecContext, codecName,
codecMediaTypeName, streamBitrate, streamMetadata,
codec, streamImageSize,
dictFoldM_
) where
import Control.Applicative ( Applicative )
import Control.Monad.Catch ( MonadMask, finally )
import Control.Monad.Reader
import Control.Monad.Trans.Either
import Data.Int ( Int64 )
import Foreign.C.String ( CString, peekCString, withCString )
import Foreign.C.Types ( CInt(..) )
import Foreign.Marshal.Utils ( with )
import Foreign.Ptr ( Ptr, nullPtr )
import Foreign.Storable
import Codec.FFmpeg.Enums
import Codec.FFmpeg.Decode
import Codec.FFmpeg.Types
{-# LINE 36 "src/Codec/FFmpeg/Probe.hsc" #-}
newtype AvFormat m a = AvFormat { unAvFormat :: ReaderT AVFormatContext m a }
deriving
( Applicative
, Functor
, Monad
, MonadIO
, MonadReader AVFormatContext
, MonadTrans
)
withAvFile :: (MonadMask m, MonadIO m) => String -> AvFormat m a -> m a
withAvFile fn f = do
ectx <- runEitherT $ openFile fn
case ectx of
Left e -> liftIO $ fail e
Right ctx -> finally
((liftIO $ avformat_find_stream_info ctx nullPtr) >> runReaderT (unAvFormat f) ctx)
(liftIO $ with ctx close_input)
nbStreams :: MonadIO m => AvFormat m Int
nbStreams = avToInt $ ask >>= \ctx ->
liftIO $ ((\hsc_ptr -> peekByteOff hsc_ptr 44)) (getPtr ctx)
{-# LINE 63 "src/Codec/FFmpeg/Probe.hsc" #-}
formatName :: MonadIO m => AvFormat m String
formatName = ask >>= \ctx -> liftIO $
((\hsc_ptr -> peekByteOff hsc_ptr 8)) (getPtr ctx) >>=
{-# LINE 67 "src/Codec/FFmpeg/Probe.hsc" #-}
((\hsc_ptr -> peekByteOff hsc_ptr 0)) >>=
{-# LINE 68 "src/Codec/FFmpeg/Probe.hsc" #-}
peekCString
duration :: MonadIO m => AvFormat m Int64
duration = ask >>= \ctx -> liftIO $ ((\hsc_ptr -> peekByteOff hsc_ptr 1088)) (getPtr ctx)
{-# LINE 72 "src/Codec/FFmpeg/Probe.hsc" #-}
formatMetadata :: MonadIO m => AvFormat m AVDictionary
formatMetadata = ask >>= liftIO . ((\hsc_ptr -> peekByteOff hsc_ptr 1192)) . getPtr
{-# LINE 75 "src/Codec/FFmpeg/Probe.hsc" #-}
newtype AvStreamT m a = AvStreamT { unAvStreamT :: ReaderT AVStream (m) a }
deriving
( Applicative
, Functor
, Monad
, MonadIO
, MonadReader AVStream
, MonadTrans
)
withStream :: (MonadIO m) => Int -> AvStreamT (AvFormat m) a -> AvFormat m a
withStream sid f = nbStreams >>= \ns -> if sid >= ns
then error $ show sid ++ " >= " ++ show ns
else do
ctx <- ask
streams <- liftIO $ ((\hsc_ptr -> peekByteOff hsc_ptr 48)) (getPtr ctx)
{-# LINE 96 "src/Codec/FFmpeg/Probe.hsc" #-}
liftIO (peekElemOff streams sid) >>= runReaderT (unAvStreamT f)
codecContext :: MonadIO m => AvStreamT m (Maybe AVCodecContext)
codecContext = do
p <- ask >>= (liftIO . ((\hsc_ptr -> peekByteOff hsc_ptr 8)) . getPtr)
{-# LINE 101 "src/Codec/FFmpeg/Probe.hsc" #-}
if (p /= nullPtr)
then return $ Just $ AVCodecContext p
else return Nothing
codecMediaTypeName :: MonadIO m => AVCodecContext -> AvStreamT m String
codecMediaTypeName cctx = liftIO $
((\hsc_ptr -> peekByteOff hsc_ptr 12)) (getPtr cctx) >>=
{-# LINE 108 "src/Codec/FFmpeg/Probe.hsc" #-}
av_get_media_type_string >>=
peekCString
codec :: MonadIO m => AVCodecContext -> AvStreamT m (Maybe AVCodec)
codec cctx = (liftIO . ((\hsc_ptr -> peekByteOff hsc_ptr 16)) . getPtr) cctx >>=
{-# LINE 113 "src/Codec/FFmpeg/Probe.hsc" #-}
\mc -> if mc == nullPtr
then return Nothing
else return $ Just $ AVCodec mc
codecName :: MonadIO m => AVCodecContext -> AvStreamT m String
codecName cctx = liftIO $ getCodecID cctx >>= avcodec_get_name >>= peekCString
streamBitrate :: MonadIO m => AVCodecContext -> AvStreamT m Int
streamBitrate cctx = liftIO $ getBitRate cctx >>= return . fromIntegral
streamImageSize :: MonadIO m => AVCodecContext -> AvStreamT m (Int, Int)
streamImageSize cctx = liftIO $ (,)
<$> liftM fromIntegral (getWidth cctx)
<*> liftM fromIntegral (getHeight cctx)
streamMetadata :: MonadIO m => AvStreamT m AVDictionary
streamMetadata = ask >>= liftIO . ((\hsc_ptr -> peekByteOff hsc_ptr 96)) . getPtr
{-# LINE 132 "src/Codec/FFmpeg/Probe.hsc" #-}
dictFoldM_
:: MonadIO m
=> ((String, String) -> m ())
-> AVDictionary
-> m ()
dictFoldM_ f d =
let
flags = (14)
{-# LINE 145 "src/Codec/FFmpeg/Probe.hsc" #-}
next ep = do
e' <- liftIO $ withCString "" $ \s -> av_dict_get d s ep flags
if (e' == nullPtr)
then return ()
else do
k <- liftIO $ ((\hsc_ptr -> peekByteOff hsc_ptr 0)) e' >>= peekCString
{-# LINE 151 "src/Codec/FFmpeg/Probe.hsc" #-}
v <- liftIO $ ((\hsc_ptr -> peekByteOff hsc_ptr 8)) e' >>= peekCString
{-# LINE 152 "src/Codec/FFmpeg/Probe.hsc" #-}
f (k, v)
next e'
in do
next nullPtr
avToInt :: Monad m => AvFormat m CInt -> AvFormat m Int
avToInt f = f >>= return . fromIntegral
foreign import ccall "av_get_media_type_string"
av_get_media_type_string :: AVMediaType -> IO CString
foreign import ccall "avcodec_get_name"
avcodec_get_name :: AVCodecID -> IO CString
foreign import ccall "av_dict_get"
av_dict_get :: AVDictionary -> CString -> Ptr () -> CInt -> IO (Ptr ())