{-# LANGUAGE CPP #-}
--  GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  This library is free software: you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public License
--  as published by the Free Software Foundation, either version 3 of
--  the License, or (at your option) any later version.
--  
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--  
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--  
--  GStreamer, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GStreamer documentation.
--  
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module Media.Streaming.GStreamer.Core.Message (
  
  Message,
  MessageClass,
  castToMessage,
  gTypeMessage,
  
  MessageType(..),
  messageTypeGetName,
  messageTypeToQuark,
  
  messageSrc,
  messageTimestamp,
  messageType,
  messageTypeName,
  messageStructure,
  
  messageNewApplication,
  messageNewClockProvide,
  messageNewClockLost,
  messageNewCustom,
  messageNewElement,
  messageNewEOS,
  messageNewError,
#if GST_CHECK_VERSION(0,10,12)
  messageNewInfo,
#endif
  messageNewNewClock,
  messageNewSegmentDone,
  messageNewSegmentStart,
  messageNewStateChanged,
  messageNewTag,
#if GST_CHECK_VERSION(0,10,11)
  messageNewBuffering,
#endif
  messageNewWarning,
  messageNewDuration,
  messageNewStateDirty,
#if GST_CHECK_VERSION(0,10,12)
  messageNewLatency,
#endif
  
  messageParseClockLost,
  messageParseClockProvide,
  messageParseError,
#if GST_CHECK_VERSION(0,10,12)
  messageParseInfo,
#endif
  messageParseNewClock,
  messageParseSegmentDone,
  messageParseSegmentStart,
  messageParseStateChanged,
  messageParseTag,
#if GST_CHECK_VERSION(0,10,11)
  messageParseBuffering,
#endif
  messageParseWarning,
  messageParseDuration, 
  
  ) where

import Control.Monad (liftM)
{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.FFI
import System.Glib.GObject
import System.Glib.UTFString
import System.Glib.GError

{# context lib = "gstreamer" prefix = "gst" #}

messageTypeGetName :: MessageType
                   -> String
messageTypeGetName messageType =
    unsafePerformIO $
        {# call message_type_get_name #} (fromIntegral $ fromEnum messageType) >>=
            peekUTFString

messageTypeToQuark :: MessageType
                   -> Quark
messageTypeToQuark messageType =
    {# call fun message_type_to_quark #} (fromIntegral $ fromEnum messageType)

messageSrc :: Message
           -> Object
messageSrc message =
    unsafePerformIO $ withMiniObject message {# get GstMessage->src #} >>=
        peekObject

messageTimestamp :: Message
                 -> ClockTime
messageTimestamp message =
    fromIntegral $ unsafePerformIO $ withMiniObject message {# get GstMessage->timestamp #}

messageType :: Message
            -> MessageType
messageType message =
    toEnum $ fromIntegral $ unsafePerformIO $
        withMiniObject message cMessageGetMessageType
foreign import ccall unsafe "_hs_gst_message_get_message_type"
    cMessageGetMessageType :: Ptr Message
                           -> IO {# type GstMessageType #}

messageTypeName :: Message
                -> String
messageTypeName =
    messageTypeGetName . messageType

messageStructure :: Message
                 -> Structure
messageStructure message =
    unsafePerformIO $
        {# call message_get_structure #} message >>=
            peekStructure

messageNewApplication :: ObjectClass objectT
                      => objectT
                      -> Structure
                      -> Message
messageNewApplication src structure =
    unsafePerformIO $
        giveStructure structure
                      ({# call message_new_application #} (toObject src)) >>=
            takeMiniObject

messageNewClockProvide :: (ObjectClass objectT, ClockClass clockT)
                       => objectT
                       -> clockT
                       -> Bool
                       -> Message
messageNewClockProvide src clock ready =
    unsafePerformIO $
        {# call message_new_clock_provide #} (toObject src)
                                             (toClock clock)
                                             (fromBool ready) >>=
            takeMiniObject

messageNewClockLost :: (ObjectClass objectT, ClockClass clockT)
                    => objectT
                    -> clockT
                    -> Message
messageNewClockLost src clock =
    unsafePerformIO $
        {# call message_new_clock_lost #} (toObject src)
                                          (toClock clock) >>=
            takeMiniObject

messageNewCustom :: ObjectClass objectT
                 => MessageType
                 -> objectT
                 -> Maybe Structure
                 -> Message
messageNewCustom messageType src structure =
    unsafePerformIO $
        (case structure of
           Just structure' ->
               giveStructure structure' messageNewCustom'
           Nothing ->
               messageNewCustom' $ Structure nullForeignPtr) >>=
            takeMiniObject
    where
      messageNewCustom' =
          {# call message_new_custom #} (cFromEnum messageType)
                                        (toObject src)

messageNewElement :: ObjectClass objectT
                  => objectT
                  -> Maybe Structure
                  -> Message
messageNewElement src structure =
    unsafePerformIO $
        (case structure of
           Just structure' ->
               giveStructure structure' messageNewElement'
           Nothing ->
               messageNewElement' $ Structure nullForeignPtr) >>=
            takeMiniObject
    where
      messageNewElement' =
          {# call message_new_element #} (toObject src)

messageNewEOS :: ObjectClass objectT
              => objectT
              -> Message
messageNewEOS src =
    unsafePerformIO $
        {# call message_new_eos #} (toObject src) >>=
            takeMiniObject

messageNewError :: ObjectClass objectT
                => objectT
                -> GError
                -> String
                -> Message
messageNewError src error debug =
    unsafePerformIO $
       with error $ \gErrorPtr -> withUTFString debug $ \debugPtr ->
           {# call message_new_error #} (toObject src)
                                        (castPtr gErrorPtr)
                                        debugPtr >>=
               takeMiniObject

#if GST_CHECK_VERSION(0,10,12)
messageNewInfo :: ObjectClass objectT
               => objectT
               -> GError
               -> String
               -> Message
messageNewInfo src error debug =
    unsafePerformIO $
       with error $ \gErrorPtr -> withUTFString debug $ \debugPtr ->
           {# call message_new_info #} (toObject src)
                                       (castPtr gErrorPtr)
                                       debugPtr >>=
               takeMiniObject
#endif

messageNewNewClock :: (ObjectClass objectT, ClockClass clockT)
                   => objectT
                   -> clockT
                   -> Message
messageNewNewClock src clock =
    unsafePerformIO $
        {# call message_new_new_clock #} (toObject src)
                                         (toClock clock) >>=
            takeMiniObject

messageNewSegmentDone :: ObjectClass objectT
                      => objectT
                      -> Format
                      -> Int64
                      -> Message
messageNewSegmentDone src format position =
    unsafePerformIO $
        {# call message_new_segment_done #} (toObject src)
                                            (fromIntegral $ fromFormat format)
                                            (fromIntegral position) >>=
            takeMiniObject

messageNewSegmentStart :: ObjectClass objectT
                       => objectT
                       -> Format
                       -> Int64
                       -> Message
messageNewSegmentStart src format position =
    unsafePerformIO $
        {# call message_new_segment_start #} (toObject src)
                                             (fromIntegral $ fromFormat format)
                                             (fromIntegral position) >>=
            takeMiniObject

messageNewStateChanged :: ObjectClass objectT
                       => objectT
                       -> State
                       -> State
                       -> State
                       -> Message
messageNewStateChanged src oldState newState pending =
    unsafePerformIO $
       {# call message_new_state_changed #} (toObject src)
                                            (cFromEnum oldState)
                                            (cFromEnum newState)
                                            (cFromEnum pending) >>=
           takeMiniObject

messageNewTag :: ObjectClass objectT
              => objectT
              -> TagList
              -> Message
messageNewTag src tagList =
    unsafePerformIO $ withTagList tagList $ \tagListPtr ->
        {# call message_new_tag #} (toObject src)
                                   (castPtr tagListPtr) >>=
            takeMiniObject

#if GST_CHECK_VERSION(0,10,11)
messageNewBuffering :: ObjectClass objectT
                    => objectT
                    -> Int
                    -> Message
messageNewBuffering src percent =
    unsafePerformIO $
        {# call message_new_buffering #} (toObject src)
                                         (fromIntegral percent) >>=
            takeMiniObject
#endif

messageNewWarning :: ObjectClass objectT
                  => objectT
                  -> GError
                  -> String
                  -> Message
messageNewWarning src error debug =
    unsafePerformIO $
       with error $ \gErrorPtr -> withUTFString debug $ \debugPtr ->
           {# call message_new_warning #} (toObject src)
                                          (castPtr gErrorPtr)
                                          debugPtr >>=
               takeMiniObject

messageNewDuration :: ObjectClass objectT
                   => objectT
                   -> Format
                   -> Int64
                   -> Message
messageNewDuration src format duration =
    unsafePerformIO $
        {# call message_new_duration #} (toObject src)
                                        (fromIntegral $ fromFormat format)
                                        (fromIntegral duration) >>=
           takeMiniObject

messageNewStateDirty :: ObjectClass objectT
                     => objectT
                     -> Message
messageNewStateDirty src =
    unsafePerformIO $
        {# call message_new_state_dirty #} (toObject src) >>=
            takeMiniObject

#if GST_CHECK_VERSION(0,10,12)
messageNewLatency :: ObjectClass objectT
                  => objectT
                  -> Message
messageNewLatency src =
    unsafePerformIO $
        {# call message_new_latency #} (toObject src) >>=
            takeMiniObject
#endif

messageParseClockLost :: Message
                      -> Maybe Clock
messageParseClockLost message | messageType message == MessageClockLost =
    Just $ unsafePerformIO $ alloca $ \clockPtr ->
        do {# call message_parse_clock_lost #} message $ castPtr clockPtr
           peek clockPtr >>= peekObject
                              | otherwise = Nothing

messageParseClockProvide :: Message
                         -> Maybe (Clock, Bool)
messageParseClockProvide message | messageType message == MessageClockProvide =
    Just $ unsafePerformIO $ alloca $ \clockPtr ->
        alloca $ \readyPtr ->
            do {# call message_parse_clock_provide #} message (castPtr clockPtr) readyPtr
               clock <- peek clockPtr >>= peekObject
               ready <- liftM toBool $ peek readyPtr
               return (clock, ready)
                                 | otherwise = Nothing

messageParseError :: Message
                  -> Maybe (GError, String)
messageParseError message | messageType message == MessageError =
    Just $ unsafePerformIO $ alloca $ \gErrorPtr ->
        alloca $ \debugPtr ->
            do {# call message_parse_error #} message (castPtr gErrorPtr) debugPtr
               gError <- do ptr <- peek gErrorPtr
                            gError <- peek ptr
                            {# call g_error_free #} $ castPtr ptr
                            return gError
               debug <- peek debugPtr >>= readUTFString
               return (gError, debug)
                          | otherwise = Nothing

#if GST_CHECK_VERSION(0,10,12)
messageParseInfo :: Message
                 -> Maybe (GError, String)
messageParseInfo message | messageType message == MessageInfo =
    Just $ unsafePerformIO $ alloca $ \gErrorPtr ->
        alloca $ \debugPtr ->
            do {# call message_parse_info #} message (castPtr gErrorPtr) debugPtr
               gError <- do ptr <- peek gErrorPtr
                            gError <- peek ptr
                            {# call g_error_free #} $ castPtr ptr
                            return gError
               debug <- peek debugPtr >>= readUTFString
               return (gError, debug)
                         | otherwise = Nothing
#endif

messageParseNewClock :: Message
                     -> Maybe Clock
messageParseNewClock message | messageType message == MessageNewClock =
    Just $ unsafePerformIO $ alloca $ \clockPtr ->
        do {# call message_parse_clock_lost #} message $ castPtr clockPtr
           peek clockPtr >>= peekObject
                             | otherwise = Nothing

messageParseSegmentDone :: Message
                        -> Maybe (Format, Int64)
messageParseSegmentDone message | messageType message == MessageSegmentDone =
    Just $ unsafePerformIO $ alloca $ \formatPtr ->
        alloca $ \positionPtr ->
            do {# call message_parse_segment_done #} message formatPtr positionPtr
               format <- liftM (toFormat . fromIntegral) $ peek formatPtr
               position <- liftM fromIntegral $ peek positionPtr
               return (format, position)
                                | otherwise = Nothing

messageParseSegmentStart :: Message
                         -> Maybe (Format, Int64)
messageParseSegmentStart message | messageType message == MessageSegmentStart =
    Just $ unsafePerformIO $ alloca $ \formatPtr ->
        alloca $ \positionPtr ->
            do {# call message_parse_segment_start #} message formatPtr positionPtr
               format <- liftM (toFormat . fromIntegral) $ peek formatPtr
               position <- liftM fromIntegral $ peek positionPtr
               return (format, position)
                                 | otherwise = Nothing

messageParseStateChanged :: Message
                         -> Maybe (State, State, State)
messageParseStateChanged message | messageType message == MessageStateChanged =
    Just $ unsafePerformIO $ alloca $ \oldStatePtr ->
        alloca $ \newStatePtr -> alloca $ \pendingPtr ->
            do {# call message_parse_state_changed #} message oldStatePtr newStatePtr pendingPtr
               oldState <- liftM cToEnum $ peek oldStatePtr
               newState <- liftM cToEnum $ peek newStatePtr
               pending  <- liftM cToEnum $ peek pendingPtr
               return (oldState, newState, pending)
                                 | otherwise = Nothing

messageParseTag :: Message
                -> Maybe TagList
messageParseTag message | messageType message == MessageTag =
    Just $ unsafePerformIO $ alloca $ \tagListPtr ->
        do {# call message_parse_tag #} message $ castPtr tagListPtr
           peek tagListPtr >>= takeTagList
                        | otherwise = Nothing

#if GST_CHECK_VERSION(0,10,11)
messageParseBuffering :: Message
                      -> Maybe Int
messageParseBuffering message | messageType message == MessageBuffering =
    Just $ fromIntegral $ unsafePerformIO $ alloca $ \percentPtr ->
        do {# call message_parse_buffering #} message percentPtr
           peek percentPtr
                              | otherwise = Nothing
#endif

messageParseWarning :: Message
                    -> Maybe (Maybe GError, Maybe String)
messageParseWarning message | messageType message == MessageWarning =
    Just $ unsafePerformIO $ alloca $ \gErrorPtr ->
        alloca $ \debugPtr ->
            do {# call message_parse_warning #} message (castPtr gErrorPtr) debugPtr
               gError <- peek gErrorPtr >>=
                             (maybePeek $ \ptr ->
                              do gError <- peek ptr
                                 {# call g_error_free #} $ castPtr ptr
                                 return gError)
               debug <- peek debugPtr >>= maybePeek readUTFString
               return (gError, debug)
                            | otherwise = Nothing

messageParseDuration :: Message
                     -> Maybe (Format, Int64)
messageParseDuration message | messageType message == MessageDuration =
    Just $ unsafePerformIO $ alloca $ \formatPtr ->
        alloca $ \positionPtr ->
            do {# call message_parse_duration #} message formatPtr positionPtr
               format <- liftM (toFormat . fromIntegral) $ peek formatPtr
               position <- liftM fromIntegral $ peek positionPtr
               return (format, position)
                             | otherwise = Nothing