{-# LINE 2 "./Graphics/UI/Gtk/WebKit/WebFrame.chs" #-}
-- -*-haskell-*-
-----------------------------------------------------------------------------
-- Module : Graphics.UI.Gtk.WebKit.WebFrame
-- Author : Cjacker Huang
-- Copyright : (c) 2009 Cjacker Huang <jzhuang@redflag-1 .com>
-- Copyright : (c) 2010 Andy Stewart <lazycat.manatee@gmail.com>
--
-- 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 2.1 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.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- The content of a 'WebView'
--
-- Note:
-- Functon `webkit_web_frame_get_global_context` can't binding now,
-- Because it need `JSGlobalContextRef` exist in JavaScriptCore.
--
-- Function `webkit_web_frame_print_full` can't binding now,
-- Because library `GtkPrintOperation` haven't binding.
--
-----------------------------------------------------------------------------

module Graphics.UI.Gtk.WebKit.WebFrame (
-- * Description
-- | A WebKitWebView contains a main WebKitWebFrame. A WebKitWebFrame contains the content of one
-- URI. The URI and name of the frame can be retrieved, the load status and progress can be observed
-- using the signals and can be controlled using the methods of the WebKitWebFrame. A WebKitWebFrame
-- can have any number of children and one child can be found by using 'webFrameFindFrame'.

-- * Types
  WebFrame,
  WebFrameClass,
  LoadStatus,

-- * Constructors
  webFrameNew,

-- * Methods
  webFrameGetWebView,
  webFrameGetName,

  webFrameGetNetworkResponse,

  webFrameGetTitle,
  webFrameGetUri,
  webFrameGetParent,
  webFrameGetLoadStatus,
  webFrameLoadUri,
  webFrameLoadString,
  webFrameLoadAlternateString,
  webFrameLoadRequest,
  webFrameStopLoading,
  webFrameReload,
  webFrameFindFrame,
  webFrameGetDataSource,
  webFrameGetHorizontalScrollbarPolicy,
  webFrameGetVerticalScrollbarPolicy,
  webFrameGetProvisionalDataSource,
  webFrameGetSecurityOrigin,
  webFramePrint,
) where

import Control.Monad (liftM)
import Data.ByteString (ByteString, useAsCString)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.GError
import Graphics.UI.Gtk.Gdk.Events
import Graphics.UI.Gtk.General.Enums

import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.WebKit.Types
{-# LINE 87 "./Graphics/UI/Gtk/WebKit/WebFrame.chs" #-}
import System.Glib.GObject
{-# LINE 88 "./Graphics/UI/Gtk/WebKit/WebFrame.chs" #-}


{-# LINE 90 "./Graphics/UI/Gtk/WebKit/WebFrame.chs" #-}

-- * Enums

data LoadStatus = LoadProvisional
                | LoadCommitted
                | LoadFinished
                | LoadFirstVisuallyNonEmptyLayout
                | LoadFailed
                deriving (Enum)

{-# LINE 94 "./Graphics/UI/Gtk/WebKit/WebFrame.chs" #-}

------------------
-- Constructors


-- | Create a new 'WebFrame' instance with the given @webview@.
--
-- A 'WebFrame' contains the content of one URI.
webFrameNew ::
    WebViewClass webview => webview -- ^ @webview@ - the given webview
 -> IO WebFrame
webFrameNew webview =
    wrapNewGObject mkWebFrame $ (\(WebView arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_new argPtr1) (toWebView webview)

-- | Return the 'WebView' that manages the given 'WebFrame'.
webFrameGetWebView ::
    WebFrameClass self => self
 -> IO WebView
webFrameGetWebView webframe =
    makeNewObject mkWebView $ liftM castPtr $ (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_web_view argPtr1) (toWebFrame webframe)

-- | Return the name of the given 'WebFrame'.
webFrameGetName ::
    (WebFrameClass self, GlibString string) => self
 -> IO (Maybe string) -- ^ the name string or @Nothing@ in case failed.
webFrameGetName webframe =
    (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_name argPtr1) (toWebFrame webframe) >>= maybePeek peekUTFString


-- | Returns a WebKitNetworkResponse object representing the response that was given to the request for
-- the given frame, or 'Nothing' if the frame was not created by a load.
--
-- * Since 1.1.18
webFrameGetNetworkResponse :: WebFrameClass self => self -> IO (Maybe NetworkResponse)
webFrameGetNetworkResponse frame =
    maybeNull (makeNewGObject mkNetworkResponse) $
   (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_network_response argPtr1) (toWebFrame frame)


-- | Return the title of the given 'WebFrame'.
webFrameGetTitle ::
    (WebFrameClass self, GlibString string) => self
 -> IO (Maybe string) -- ^ the title string or @Nothing@ in case failed.
webFrameGetTitle webframe =
    (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_title argPtr1) (toWebFrame webframe) >>= maybePeek peekUTFString

-- | Return the URI of the given 'WebFrame'.
webFrameGetUri ::
    (WebFrameClass self, GlibString string) => self
 -> IO (Maybe string) -- ^ the URI string or @Nothing@ in case failed.
webFrameGetUri webframe =
    (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_uri argPtr1) (toWebFrame webframe) >>= maybePeek peekUTFString

-- | Return the 'WebFrame''s parent frame if it has one,
-- Otherwise return Nothing.
webFrameGetParent ::
    WebFrameClass self => self
 -> IO (Maybe WebFrame) -- ^ a 'WebFrame' or @Nothing@ in case failed.
webFrameGetParent webframe =
    maybeNull (makeNewGObject mkWebFrame) $ (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_parent argPtr1) (toWebFrame webframe)

-- | Determines the current status of the load.
--
-- frame : a WebKitWebView
--
-- * Since 1.1.7
webFrameGetLoadStatus ::
    WebFrameClass self => self
 -> IO LoadStatus
webFrameGetLoadStatus ls =
    liftM (toEnum . fromIntegral) $ (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_load_status argPtr1) (toWebFrame ls)

-- | Request loading of the specified URI string.
webFrameLoadUri ::
    (WebFrameClass self, GlibString string) => self
 -> string -- ^ @uri@ - an URI string.
 -> IO ()
webFrameLoadUri webframe uri =
    withUTFString uri $ \uriPtr -> (\(WebFrame arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_load_uri argPtr1 arg2)
{-# LINE 173 "./Graphics/UI/Gtk/WebKit/WebFrame.chs" #-}
    (toWebFrame webframe)
    uriPtr

-- | Requests loading of the given @content@
-- with the specified @mime_type@ and @base_uri@.
--
-- If @mime_type@ is @Nothing@, \"text/html\" is assumed.
--
-- If want control over the encoding use `webFrameLoadByteString`
webFrameLoadString ::
    (WebFrameClass self, GlibString string) => self
 -> string -- ^ @content@ - the content string to be loaded.
 -> (Maybe string) -- ^ @mime_type@ - the MIME type or @Nothing@.
 -> string -- ^ @base_uri@ - the base URI for relative locations.
 -> IO()
webFrameLoadString webframe content mimetype baseuri =
    withUTFString content $ \contentPtr ->
    maybeWith withUTFString mimetype $ \mimetypePtr ->
    withUTFString baseuri $ \baseuriPtr ->
        (\(WebFrame arg1) arg2 arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_load_string argPtr1 arg2 arg3 arg4 arg5)
{-# LINE 193 "./Graphics/UI/Gtk/WebKit/WebFrame.chs" #-}
          (toWebFrame webframe)
          contentPtr
          mimetypePtr
          nullPtr
          baseuriPtr

-- | Requests loading of the given @content@
-- with the specified @mime_type@, @encoding@ and @base_uri@.
--
-- If @mime_type@ is @Nothing@, \"text/html\" is assumed.
--
-- If @encoding@ is @Nothing@, \"UTF-8\" is assumed.
webFrameLoadByteString ::
    (WebFrameClass self, GlibString string) => self
 -> ByteString -- ^ @content@ - the content string to be loaded.
 -> (Maybe string) -- ^ @mime_type@ - the MIME type or @Nothing@.
 -> (Maybe string) -- ^ @encoding@ - the encoding or @Nothing@.
 -> string -- ^ @base_uri@ - the base URI for relative locations.
 -> IO()
webFrameLoadByteString webframe content mimetype encoding baseuri =
    useAsCString content $ \contentPtr ->
    maybeWith withUTFString mimetype $ \mimetypePtr ->
    maybeWith withUTFString encoding $ \encodingPtr ->
    withUTFString baseuri $ \baseuriPtr ->
        (\(WebFrame arg1) arg2 arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_load_string argPtr1 arg2 arg3 arg4 arg5)
{-# LINE 218 "./Graphics/UI/Gtk/WebKit/WebFrame.chs" #-}
          (toWebFrame webframe)
          contentPtr
          mimetypePtr
          encodingPtr
          baseuriPtr


-- |Request loading of an alternate content for a URL that is unreachable.
--
-- Using this method will preserve the back-forward list.
-- The URI passed in @base_uri@ has to be an absolute URI.
webFrameLoadAlternateString ::
    (WebFrameClass self, GlibString string) => self
 -> string -- ^ @content@ - the alternate content to display
            -- as the main page of the frame
 -> string -- ^ @base_uri@ - the base URI for relative locations.
 -> string -- ^ @unreachable_url@ - the URL for the alternate page content.
 -> IO()
webFrameLoadAlternateString webframe content baseurl unreachableurl =
    withUTFString content $ \contentPtr ->
    withUTFString baseurl $ \baseurlPtr ->
    withUTFString unreachableurl $ \unreachableurlPtr ->
        (\(WebFrame arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_load_alternate_string argPtr1 arg2 arg3 arg4)
{-# LINE 241 "./Graphics/UI/Gtk/WebKit/WebFrame.chs" #-}
          (toWebFrame webframe)
          contentPtr
          baseurlPtr
          unreachableurlPtr

-- | Connects to a given URI by initiating an asynchronous client request.
--
-- Creates a provisional data source that will transition to a committed data source once any data has been received.
-- Use 'webFrameStopLoading' to stop the load.
-- This function is typically invoked on the main frame.
webFrameLoadRequest ::
   (WebFrameClass self, NetworkRequestClass requ) => self -> requ
 -> IO ()
webFrameLoadRequest webframe request =
  (\(WebFrame arg1) (NetworkRequest arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_web_frame_load_request argPtr1 argPtr2) (toWebFrame webframe) (toNetworkRequest request)

-- | Stops and pending loads on the given data source and those of its children.
webFrameStopLoading ::
    WebFrameClass self => self
 -> IO()
webFrameStopLoading webframe =
    (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_stop_loading argPtr1) (toWebFrame webframe)

-- |Reloads the initial request.
webFrameReload ::
    WebFrameClass self => self
 -> IO()
webFrameReload webframe =
    (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_reload argPtr1) (toWebFrame webframe)

-- |Return the 'WebFrame' associated with the given name
-- or @Nothing@ in case none if found
--
-- For pre-defined names, return the given webframe if name is
webFrameFindFrame::
    (WebFrameClass self, GlibString string) => self
 -> string -- ^ @name@ - the name of the frame to be found.
 -> IO (Maybe WebFrame)
webFrameFindFrame webframe name =
    withUTFString name $ \namePtr ->
 maybeNull (makeNewGObject mkWebFrame) $
          (\(WebFrame arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_find_frame argPtr1 arg2) (toWebFrame webframe) namePtr

-- | Returns the committed data source.
webFrameGetDataSource ::
   WebFrameClass self => self
 -> IO WebDataSource
webFrameGetDataSource webframe =
  makeNewGObject mkWebDataSource $ (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_data_source argPtr1) (toWebFrame webframe)

-- | Return the policy of horizontal scrollbar.
webFrameGetHorizontalScrollbarPolicy ::
   WebFrameClass self => self
 -> IO PolicyType
webFrameGetHorizontalScrollbarPolicy webframe =
    liftM (toEnum.fromIntegral) $
    (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_horizontal_scrollbar_policy argPtr1) (toWebFrame webframe)

-- | Return the policy of vertical scrollbar.
webFrameGetVerticalScrollbarPolicy ::
   WebFrameClass self => self
 -> IO PolicyType
webFrameGetVerticalScrollbarPolicy webframe =
    liftM (toEnum.fromIntegral) $
    (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_vertical_scrollbar_policy argPtr1) (toWebFrame webframe)

-- | You use the 'webFrameLoadRequest' method to initiate a request that creates a provisional data source.
-- The provisional data source will transition to a committed data source once any data has been received.
-- Use 'webFrameGetDataSource' to get the committed data source.
webFrameGetProvisionalDataSource ::
   WebFrameClass self => self
 -> IO WebDataSource
webFrameGetProvisionalDataSource webframe =
  makeNewGObject mkWebDataSource $ (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_provisional_data_source argPtr1) (toWebFrame webframe)

-- | Returns the frame's security origin.
webFrameGetSecurityOrigin ::
   WebFrameClass self => self
 -> IO SecurityOrigin
webFrameGetSecurityOrigin webframe =
  makeNewGObject mkSecurityOrigin $ (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_get_security_origin argPtr1) (toWebFrame webframe)

-- |Prints the given 'WebFrame'.
--
-- by presenting a print dialog to the user.
webFramePrint::
    WebFrameClass self => self
 -> IO()
webFramePrint webframe =
  (\(WebFrame arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_web_frame_print argPtr1) (toWebFrame webframe)

foreign import ccall safe "webkit_web_frame_new"
  webkit_web_frame_new :: ((Ptr WebView) -> (IO (Ptr WebFrame)))

foreign import ccall safe "webkit_web_frame_get_web_view"
  webkit_web_frame_get_web_view :: ((Ptr WebFrame) -> (IO (Ptr WebView)))

foreign import ccall safe "webkit_web_frame_get_name"
  webkit_web_frame_get_name :: ((Ptr WebFrame) -> (IO (Ptr CChar)))

foreign import ccall safe "webkit_web_frame_get_network_response"
  webkit_web_frame_get_network_response :: ((Ptr WebFrame) -> (IO (Ptr NetworkResponse)))

foreign import ccall safe "webkit_web_frame_get_title"
  webkit_web_frame_get_title :: ((Ptr WebFrame) -> (IO (Ptr CChar)))

foreign import ccall safe "webkit_web_frame_get_uri"
  webkit_web_frame_get_uri :: ((Ptr WebFrame) -> (IO (Ptr CChar)))

foreign import ccall safe "webkit_web_frame_get_parent"
  webkit_web_frame_get_parent :: ((Ptr WebFrame) -> (IO (Ptr WebFrame)))

foreign import ccall safe "webkit_web_frame_get_load_status"
  webkit_web_frame_get_load_status :: ((Ptr WebFrame) -> (IO CInt))

foreign import ccall safe "webkit_web_frame_load_uri"
  webkit_web_frame_load_uri :: ((Ptr WebFrame) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "webkit_web_frame_load_string"
  webkit_web_frame_load_string :: ((Ptr WebFrame) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ()))))))

foreign import ccall safe "webkit_web_frame_load_alternate_string"
  webkit_web_frame_load_alternate_string :: ((Ptr WebFrame) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ())))))

foreign import ccall safe "webkit_web_frame_load_request"
  webkit_web_frame_load_request :: ((Ptr WebFrame) -> ((Ptr NetworkRequest) -> (IO ())))

foreign import ccall safe "webkit_web_frame_stop_loading"
  webkit_web_frame_stop_loading :: ((Ptr WebFrame) -> (IO ()))

foreign import ccall safe "webkit_web_frame_reload"
  webkit_web_frame_reload :: ((Ptr WebFrame) -> (IO ()))

foreign import ccall safe "webkit_web_frame_find_frame"
  webkit_web_frame_find_frame :: ((Ptr WebFrame) -> ((Ptr CChar) -> (IO (Ptr WebFrame))))

foreign import ccall safe "webkit_web_frame_get_data_source"
  webkit_web_frame_get_data_source :: ((Ptr WebFrame) -> (IO (Ptr WebDataSource)))

foreign import ccall safe "webkit_web_frame_get_horizontal_scrollbar_policy"
  webkit_web_frame_get_horizontal_scrollbar_policy :: ((Ptr WebFrame) -> (IO CInt))

foreign import ccall safe "webkit_web_frame_get_vertical_scrollbar_policy"
  webkit_web_frame_get_vertical_scrollbar_policy :: ((Ptr WebFrame) -> (IO CInt))

foreign import ccall safe "webkit_web_frame_get_provisional_data_source"
  webkit_web_frame_get_provisional_data_source :: ((Ptr WebFrame) -> (IO (Ptr WebDataSource)))

foreign import ccall safe "webkit_web_frame_get_security_origin"
  webkit_web_frame_get_security_origin :: ((Ptr WebFrame) -> (IO (Ptr SecurityOrigin)))

foreign import ccall safe "webkit_web_frame_print"
  webkit_web_frame_print :: ((Ptr WebFrame) -> (IO ()))