{-# LINE 1 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
module Database.PostgreSQL.PQTypes.Internal.Notification (
    Channel(..)
  , Notification(..)
  , getNotificationIO
  ) where

import Control.Concurrent
import Control.Monad
import Control.Monad.Fix
import Data.String
import Data.Typeable
import Foreign.Ptr
import Foreign.Storable
import Prelude
import System.Posix.Types
import System.Timeout
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

import Database.PostgreSQL.PQTypes.Internal.C.Interface
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Connection
import Database.PostgreSQL.PQTypes.Internal.State
import Database.PostgreSQL.PQTypes.Internal.Utils
import Database.PostgreSQL.PQTypes.SQL.Raw





foreign import ccall unsafe "PQnotifies"
  c_PQnotifies :: Ptr PGconn -> IO (Ptr Notification)

----------------------------------------

-- | Representation of notification channel.
newtype Channel = Channel (RawSQL ())
  deriving (Eq, Ord, Typeable)

instance IsString Channel where
  fromString = Channel . fromString

instance Show Channel where
  showsPrec n (Channel chan) = ("Channel " ++) . showsPrec n (unRawSQL chan)

----------------------------------------

-- | Representation of a notification sent by PostgreSQL.
data Notification = Notification {
-- | Process ID of notifying server.
  ntPID     :: !CPid
  -- | Notification channel name.
, ntChannel :: !Channel
  -- | Notification payload string.
, ntPayload :: !T.Text
} deriving (Eq, Ord, Show, Typeable)

instance Storable Notification where
  sizeOf _ = (32)
{-# LINE 62 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
  alignment _ = 8
{-# LINE 63 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
  peek ptr = do
    ntPID <- return . CPid
      =<< (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 66 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
    ntChannel <- fmap (Channel . flip rawSQL () . T.decodeUtf8) . BS.packCString
      =<< (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 68 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
    ntPayload <- fmap T.decodeUtf8 . BS.packCString
      =<< (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 70 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
    return Notification{..}
  poke _ _ = error "Storable Notification: poke is not supposed to be used"

----------------------------------------

-- | Low-level function that waits for a notification for a given
-- number of microseconds (it uses 'timeout' function internally).
getNotificationIO :: DBState m -> Int -> IO (Maybe Notification)
getNotificationIO st n = timeout n $ do
  withConnectionData (dbConnection st) fname $ \cd -> fix $ \loop -> do
    let conn = cdPtr cd
    mmsg <- tryGet conn
    case mmsg of
      Just msg -> return (cd, msg)
      Nothing -> do
        fd <- c_PQsocket conn
        if fd == -1
          then hpqTypesError $ fname ++ ": invalid file descriptor"
          else do
            threadWaitRead fd
            res <- c_PQconsumeInput conn
            when (res /= 1) $ do
              throwLibPQError conn fname
            loop
  where
    fname :: String
    fname = "getNotificationIO"

    tryGet :: Ptr PGconn -> IO (Maybe Notification)
    tryGet connPtr = E.mask_ $ do
      ptr <- c_PQnotifies connPtr
      if ptr /= nullPtr
        then do
          msg <- peek ptr
          c_PQfreemem ptr
          return $ Just msg
        else return Nothing