{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.WebKit.Objects.HitTestResult
    ( 

-- * Exported types
    HitTestResult(..)                       ,
    HitTestResultK                          ,
    toHitTestResult                         ,
    noHitTestResult                         ,


 -- * Properties
-- ** Context
    HitTestResultContextPropertyInfo        ,
    constructHitTestResultContext           ,
    getHitTestResultContext                 ,


-- ** ImageUri
    HitTestResultImageUriPropertyInfo       ,
    constructHitTestResultImageUri          ,
    getHitTestResultImageUri                ,


-- ** InnerNode
    HitTestResultInnerNodePropertyInfo      ,
    constructHitTestResultInnerNode         ,
    getHitTestResultInnerNode               ,


-- ** LinkUri
    HitTestResultLinkUriPropertyInfo        ,
    constructHitTestResultLinkUri           ,
    getHitTestResultLinkUri                 ,


-- ** MediaUri
    HitTestResultMediaUriPropertyInfo       ,
    constructHitTestResultMediaUri          ,
    getHitTestResultMediaUri                ,


-- ** X
    HitTestResultXPropertyInfo              ,
    constructHitTestResultX                 ,
    getHitTestResultX                       ,


-- ** Y
    HitTestResultYPropertyInfo              ,
    constructHitTestResultY                 ,
    getHitTestResultY                       ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.WebKit.Types
import GI.WebKit.Callbacks
import qualified GI.GObject as GObject

newtype HitTestResult = HitTestResult (ForeignPtr HitTestResult)
foreign import ccall "webkit_hit_test_result_get_type"
    c_webkit_hit_test_result_get_type :: IO GType

type instance ParentTypes HitTestResult = HitTestResultParentTypes
type HitTestResultParentTypes = '[GObject.Object]

instance GObject HitTestResult where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_webkit_hit_test_result_get_type
    

class GObject o => HitTestResultK o
instance (GObject o, IsDescendantOf HitTestResult o) => HitTestResultK o

toHitTestResult :: HitTestResultK o => o -> IO HitTestResult
toHitTestResult = unsafeCastTo HitTestResult

noHitTestResult :: Maybe HitTestResult
noHitTestResult = Nothing

-- VVV Prop "context"
   -- Type: TInterface "WebKit" "HitTestResultContext"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getHitTestResultContext :: (MonadIO m, HitTestResultK o) => o -> m [HitTestResultContext]
getHitTestResultContext obj = liftIO $ getObjectPropertyFlags obj "context"

constructHitTestResultContext :: [HitTestResultContext] -> IO ([Char], GValue)
constructHitTestResultContext val = constructObjectPropertyFlags "context" val

data HitTestResultContextPropertyInfo
instance AttrInfo HitTestResultContextPropertyInfo where
    type AttrAllowedOps HitTestResultContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint HitTestResultContextPropertyInfo = (~) [HitTestResultContext]
    type AttrBaseTypeConstraint HitTestResultContextPropertyInfo = HitTestResultK
    type AttrGetType HitTestResultContextPropertyInfo = [HitTestResultContext]
    type AttrLabel HitTestResultContextPropertyInfo = "HitTestResult::context"
    attrGet _ = getHitTestResultContext
    attrSet _ = undefined
    attrConstruct _ = constructHitTestResultContext

-- VVV Prop "image-uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getHitTestResultImageUri :: (MonadIO m, HitTestResultK o) => o -> m T.Text
getHitTestResultImageUri obj = liftIO $ getObjectPropertyString obj "image-uri"

constructHitTestResultImageUri :: T.Text -> IO ([Char], GValue)
constructHitTestResultImageUri val = constructObjectPropertyString "image-uri" val

data HitTestResultImageUriPropertyInfo
instance AttrInfo HitTestResultImageUriPropertyInfo where
    type AttrAllowedOps HitTestResultImageUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint HitTestResultImageUriPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint HitTestResultImageUriPropertyInfo = HitTestResultK
    type AttrGetType HitTestResultImageUriPropertyInfo = T.Text
    type AttrLabel HitTestResultImageUriPropertyInfo = "HitTestResult::image-uri"
    attrGet _ = getHitTestResultImageUri
    attrSet _ = undefined
    attrConstruct _ = constructHitTestResultImageUri

-- VVV Prop "inner-node"
   -- Type: TInterface "WebKit" "DOMNode"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getHitTestResultInnerNode :: (MonadIO m, HitTestResultK o) => o -> m DOMNode
getHitTestResultInnerNode obj = liftIO $ getObjectPropertyObject obj "inner-node" DOMNode

constructHitTestResultInnerNode :: (DOMNodeK a) => a -> IO ([Char], GValue)
constructHitTestResultInnerNode val = constructObjectPropertyObject "inner-node" val

data HitTestResultInnerNodePropertyInfo
instance AttrInfo HitTestResultInnerNodePropertyInfo where
    type AttrAllowedOps HitTestResultInnerNodePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint HitTestResultInnerNodePropertyInfo = DOMNodeK
    type AttrBaseTypeConstraint HitTestResultInnerNodePropertyInfo = HitTestResultK
    type AttrGetType HitTestResultInnerNodePropertyInfo = DOMNode
    type AttrLabel HitTestResultInnerNodePropertyInfo = "HitTestResult::inner-node"
    attrGet _ = getHitTestResultInnerNode
    attrSet _ = undefined
    attrConstruct _ = constructHitTestResultInnerNode

-- VVV Prop "link-uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getHitTestResultLinkUri :: (MonadIO m, HitTestResultK o) => o -> m T.Text
getHitTestResultLinkUri obj = liftIO $ getObjectPropertyString obj "link-uri"

constructHitTestResultLinkUri :: T.Text -> IO ([Char], GValue)
constructHitTestResultLinkUri val = constructObjectPropertyString "link-uri" val

data HitTestResultLinkUriPropertyInfo
instance AttrInfo HitTestResultLinkUriPropertyInfo where
    type AttrAllowedOps HitTestResultLinkUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint HitTestResultLinkUriPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint HitTestResultLinkUriPropertyInfo = HitTestResultK
    type AttrGetType HitTestResultLinkUriPropertyInfo = T.Text
    type AttrLabel HitTestResultLinkUriPropertyInfo = "HitTestResult::link-uri"
    attrGet _ = getHitTestResultLinkUri
    attrSet _ = undefined
    attrConstruct _ = constructHitTestResultLinkUri

-- VVV Prop "media-uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getHitTestResultMediaUri :: (MonadIO m, HitTestResultK o) => o -> m T.Text
getHitTestResultMediaUri obj = liftIO $ getObjectPropertyString obj "media-uri"

constructHitTestResultMediaUri :: T.Text -> IO ([Char], GValue)
constructHitTestResultMediaUri val = constructObjectPropertyString "media-uri" val

data HitTestResultMediaUriPropertyInfo
instance AttrInfo HitTestResultMediaUriPropertyInfo where
    type AttrAllowedOps HitTestResultMediaUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint HitTestResultMediaUriPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint HitTestResultMediaUriPropertyInfo = HitTestResultK
    type AttrGetType HitTestResultMediaUriPropertyInfo = T.Text
    type AttrLabel HitTestResultMediaUriPropertyInfo = "HitTestResult::media-uri"
    attrGet _ = getHitTestResultMediaUri
    attrSet _ = undefined
    attrConstruct _ = constructHitTestResultMediaUri

-- VVV Prop "x"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getHitTestResultX :: (MonadIO m, HitTestResultK o) => o -> m Int32
getHitTestResultX obj = liftIO $ getObjectPropertyCInt obj "x"

constructHitTestResultX :: Int32 -> IO ([Char], GValue)
constructHitTestResultX val = constructObjectPropertyCInt "x" val

data HitTestResultXPropertyInfo
instance AttrInfo HitTestResultXPropertyInfo where
    type AttrAllowedOps HitTestResultXPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint HitTestResultXPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint HitTestResultXPropertyInfo = HitTestResultK
    type AttrGetType HitTestResultXPropertyInfo = Int32
    type AttrLabel HitTestResultXPropertyInfo = "HitTestResult::x"
    attrGet _ = getHitTestResultX
    attrSet _ = undefined
    attrConstruct _ = constructHitTestResultX

-- VVV Prop "y"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getHitTestResultY :: (MonadIO m, HitTestResultK o) => o -> m Int32
getHitTestResultY obj = liftIO $ getObjectPropertyCInt obj "y"

constructHitTestResultY :: Int32 -> IO ([Char], GValue)
constructHitTestResultY val = constructObjectPropertyCInt "y" val

data HitTestResultYPropertyInfo
instance AttrInfo HitTestResultYPropertyInfo where
    type AttrAllowedOps HitTestResultYPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint HitTestResultYPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint HitTestResultYPropertyInfo = HitTestResultK
    type AttrGetType HitTestResultYPropertyInfo = Int32
    type AttrLabel HitTestResultYPropertyInfo = "HitTestResult::y"
    attrGet _ = getHitTestResultY
    attrSet _ = undefined
    attrConstruct _ = constructHitTestResultY

type instance AttributeList HitTestResult = HitTestResultAttributeList
type HitTestResultAttributeList = ('[ '("context", HitTestResultContextPropertyInfo), '("image-uri", HitTestResultImageUriPropertyInfo), '("inner-node", HitTestResultInnerNodePropertyInfo), '("link-uri", HitTestResultLinkUriPropertyInfo), '("media-uri", HitTestResultMediaUriPropertyInfo), '("x", HitTestResultXPropertyInfo), '("y", HitTestResultYPropertyInfo)] :: [(Symbol, *)])

type instance SignalList HitTestResult = HitTestResultSignalList
type HitTestResultSignalList = ('[ '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])