Add the tree view notification functions.

These are needed by any custom TreeModel implementation that allows changes in
the model. They are to tell any watcing views of changes in the model so the
views can update themselves appropriately.

darcs-hash:20060117113329-b4c10-df3229caaeb907e6aaa6e4fc3970f5460fa8cc74.gz

-- -*-haskell-*-
--  GIMP Toolkit (GTK) CustomStore TreeModel
--
--  Author : Duncan Coutts
--
--  Created: 19 Sep 2005
--
--  Version $Revision: 1.1 $ from $Date: 2005/12/08 18:12:43 $
--
--  Copyright (C) 2005 Duncan Coutts
--
--  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  : custom-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Allows a custom data structure to be used with the 'TreeView'
--
module Graphics.UI.Gtk.TreeList.CustomStore (
  CustomStore(..),
  customStoreNew,

  -- * View notifcation functions
  treeModelRowChanged,
  treeModelRowInserted,
  treeModelRowHasChildToggled,
  treeModelRowDeleted,
  treeModelRowsReordered,
  ) where

import Monad	(liftM, when)

import System.Glib.FFI			hiding	(maybeNull)
import System.Glib.Flags
import System.Glib.GObject			(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.TreeList.TreeModel#}
{#import Graphics.UI.Gtk.TreeList.TreeIter#}
{#import Graphics.UI.Gtk.TreeList.TreePath#}
import System.Glib.StoreValue			(TMType(..), GenericValue(..)
						,valueSetGenericValue)
{#import System.Glib.GValue#}			(GValue(GValue), allocaGValue)
{#import System.Glib.GType#}			(GType)
import System.Glib.GValueTypes                  (valueSetString)

{# context lib="gtk" prefix="gtk" #}

data CustomStore = CustomStore {
    customStoreGetFlags      :: IO [TreeModelFlags],
    customStoreGetNColumns   :: IO Int,
    customStoreGetColumnType :: Int -> IO GType,
    customStoreGetIter       :: TreePath -> IO (Maybe TreeIter),              -- convert a path to an iterator
    customStoreGetPath       :: TreeIter -> IO TreePath,                      -- convert an interator to a path
    customStoreGetValue      :: TreeIter -> Int -> GValue -> IO (),           -- get the value at an iter and column
    customStoreIterNext      :: TreeIter -> IO (Maybe TreeIter),              -- following row (if any)
    customStoreIterChildren  :: Maybe TreeIter -> IO (Maybe TreeIter),        -- first child row (if any)
    customStoreIterHasChild  :: TreeIter -> IO Bool,                          -- row has any children at all
    customStoreIterNChildren :: Maybe TreeIter -> IO Int,                     -- number of children of a row
    customStoreIterNthChild  :: Maybe TreeIter -> Int -> IO (Maybe TreeIter), -- nth child row of a given row
    customStoreIterParent    :: TreeIter -> IO (Maybe TreeIter),              -- parent row of a row
    customStoreRefNode       :: TreeIter -> IO (),                            -- caching hint
    customStoreUnrefNode     :: TreeIter -> IO ()                             -- caching hint
  }

customStoreGetFlags_static :: StablePtr CustomStore -> IO CInt
customStoreGetFlags_static storePtr = do
  store <- deRefStablePtr storePtr
  liftM (fromIntegral . fromFlags) $ customStoreGetFlags store

foreign export ccall "gtk2hs_store_get_flags_impl"
  customStoreGetFlags_static :: StablePtr CustomStore -> IO CInt

customStoreGetNColumns_static :: StablePtr CustomStore -> IO CInt
customStoreGetNColumns_static storePtr = do
  store <- deRefStablePtr storePtr
  liftM fromIntegral $ customStoreGetNColumns store

foreign export ccall "gtk2hs_store_get_n_columns_impl"
  customStoreGetNColumns_static :: StablePtr CustomStore -> IO CInt

customStoreGetColumnType_static :: StablePtr CustomStore -> CInt -> IO GType
customStoreGetColumnType_static storePtr column = do
  store <- deRefStablePtr storePtr
  customStoreGetColumnType store (fromIntegral column)

foreign export ccall "gtk2hs_store_get_column_type_impl"
  customStoreGetColumnType_static :: StablePtr CustomStore -> CInt -> IO GType

customStoreGetIter_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr NativeTreePath -> IO CInt
customStoreGetIter_static storePtr iterPtr pathPtr = do
  store <- deRefStablePtr storePtr
  path <- peekTreePath pathPtr
  iter <- customStoreGetIter store path
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)

foreign export ccall "gtk2hs_store_get_iter_impl"
  customStoreGetIter_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr NativeTreePath -> IO CInt

customStoreGetPath_static :: StablePtr CustomStore -> Ptr TreeIter -> IO (Ptr NativeTreePath)
customStoreGetPath_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  path <- customStoreGetPath store iter
  NativeTreePath pathPtr <- newTreePath path
  return pathPtr

foreign export ccall "gtk2hs_store_get_path_impl"
  customStoreGetPath_static :: StablePtr CustomStore -> Ptr TreeIter -> IO (Ptr NativeTreePath)

customStoreGetValue_static :: StablePtr CustomStore -> Ptr TreeIter -> CInt -> Ptr GValue -> IO ()
customStoreGetValue_static storePtr iterPtr column gvaluePtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  customStoreGetValue store iter (fromIntegral column) (GValue gvaluePtr)

foreign export ccall "gtk2hs_store_get_value_impl"
  customStoreGetValue_static :: StablePtr CustomStore -> Ptr TreeIter -> CInt -> Ptr GValue -> IO ()

customStoreIterNext_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt
customStoreIterNext_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  iter' <- customStoreIterNext store iter
  case iter' of
    Nothing    -> return (fromBool False)
    Just iter' -> do poke iterPtr iter'
                     return (fromBool True)

foreign export ccall "gtk2hs_store_iter_next_impl"
  customStoreIterNext_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt

customStoreIterChildren_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> IO CInt
customStoreIterChildren_static storePtr iterPtr parentIterPtr = do
  store <- deRefStablePtr storePtr
  parentIter <- maybeNull peek parentIterPtr
  iter <- customStoreIterChildren store parentIter
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)

foreign export ccall "gtk2hs_store_iter_children_impl"
  customStoreIterChildren_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> IO CInt

customStoreIterHasChild_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt
customStoreIterHasChild_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  liftM fromBool $ customStoreIterHasChild store iter

foreign export ccall "gtk2hs_store_iter_has_child_impl"
  customStoreIterHasChild_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt

customStoreIterNChildren_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt
customStoreIterNChildren_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- maybeNull peek iterPtr
  liftM fromIntegral $ customStoreIterNChildren store iter

foreign export ccall "gtk2hs_store_iter_n_children_impl"
  customStoreIterNChildren_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt

customStoreIterNthChild_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt
customStoreIterNthChild_static storePtr iterPtr parentIterPtr n = do
  store <- deRefStablePtr storePtr
  parentIter <- maybeNull peek parentIterPtr
  iter <- customStoreIterNthChild store parentIter (fromIntegral n)
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)

foreign export ccall "gtk2hs_store_iter_nth_child_impl"
  customStoreIterNthChild_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt

customStoreIterParent_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> IO CInt
customStoreIterParent_static  storePtr iterPtr childIterPtr = do
  store <- deRefStablePtr storePtr
  childIter <- peek childIterPtr
  iter <- customStoreIterParent store childIter
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)

foreign export ccall "gtk2hs_store_iter_parent_impl"
  customStoreIterParent_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> IO CInt

customStoreRefNode_static :: StablePtr CustomStore -> Ptr TreeIter -> IO ()
customStoreRefNode_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  customStoreRefNode store iter

foreign export ccall "gtk2hs_store_ref_node_impl"
  customStoreRefNode_static :: StablePtr CustomStore -> Ptr TreeIter -> IO ()

customStoreUnrefNode_static :: StablePtr CustomStore -> Ptr TreeIter -> IO ()
customStoreUnrefNode_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  customStoreUnrefNode store iter

foreign export ccall "gtk2hs_store_unref_node_impl"
  customStoreUnrefNode_static :: StablePtr CustomStore -> Ptr TreeIter -> IO ()

foreign import ccall unsafe "gtk2hs_store_new"
  gtk2hs_store_new :: StablePtr CustomStore -> IO (Ptr TreeModel)

customStoreNew :: CustomStore -> IO TreeModel
customStoreNew impl = do
  implPtr <- newStablePtr impl
  makeNewGObject mkTreeModel $
    gtk2hs_store_new implPtr

maybeNull :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybeNull marshal ptr
  | ptr == nullPtr = return Nothing
  | otherwise      = liftM Just (marshal ptr)

-- | Emits the \"row_changed\" signal on the 'TreeModel'.
--
treeModelRowChanged :: TreeModelClass self => self
 -> TreePath -- ^ @path@ - A 'TreePath' pointing to the changed row
 -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the changed row
 -> IO ()
treeModelRowChanged self path iter =
  withTreePath path $ \pathPtr ->
  with iter $ \iterPtr ->
  {# call gtk_tree_model_row_changed #}
    (toTreeModel self)
    pathPtr
    iterPtr

-- | Emits the \"row_inserted\" signal on the 'TreeModel'
--
treeModelRowInserted :: TreeModelClass self => self
 -> TreePath -- ^ @path@ - A 'TreePath' pointing to the inserted row
 -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the inserted row
 -> IO ()
treeModelRowInserted self path iter =
  withTreePath path $ \pathPtr ->
  with iter $ \iterPtr ->
  {# call gtk_tree_model_row_inserted #}
    (toTreeModel self)
    pathPtr
    iterPtr

-- | Emits the \"row_has_child_toggled\" signal on the 'TreeModel'. This should
-- be called by models after the child state of a node changes.
--
treeModelRowHasChildToggled :: TreeModelClass self => self
 -> TreePath -- ^ @path@ - A 'TreePath' pointing to the changed row
 -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the changed row
 -> IO ()
treeModelRowHasChildToggled self path iter =
  withTreePath path $ \pathPtr ->
  with iter $ \iterPtr ->
  {# call gtk_tree_model_row_has_child_toggled #}
    (toTreeModel self)
    pathPtr
    iterPtr

-- | Emits the \"row_deleted\" signal the 'TreeModel'. This should be called by
-- models after a row has been removed. The location pointed to by @path@
-- should be the location that the row previously was at. It may not be a valid
-- location anymore.
--
treeModelRowDeleted :: TreeModelClass self => self
 -> TreePath -- ^ @path@ - A 'TreePath' pointing to the previous location of
             -- the deleted row.
 -> IO ()
treeModelRowDeleted self path =
  withTreePath path $ \pathPtr ->
  {# call gtk_tree_model_row_deleted #}
    (toTreeModel self)
    pathPtr

-- | Emits the \"rows_reordered\" signal on the 'TreeModel'. This should be
-- called by models when their rows have been reordered.
--
treeModelRowsReordered :: TreeModelClass self => self
 -> TreePath -- ^ @path@ - A 'TreePath' pointing to the tree node whose
             -- children have been reordered
 -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the node whose
             -- children have been reordered, or {@NULL@, FIXME: this should
             -- probably be converted to a Maybe data type} if the depth of
             -- @path@ is 0.
 -> [Int]   -- ^ @newOrder@ - an array of integers mapping the current
             -- position of each child to its old position before the
             -- re-ordering, i.e. @newOrder@@[newpos] = oldpos@.
 -> IO ()
treeModelRowsReordered self path iter newOrder =
  withTreePath path $ \pathPtr ->
  with iter $ \iterPtr ->
  withArrayLen (map fromIntegral newOrder) $ \newLength newOrderArrPtr -> do
  --check newOrder is the right length or it'll overrun
  curLength <- treeModelIterNChildren self (Just iter)
  when (curLength /= newLength)
       (fail "treeModelRowsReordered: mapping wrong length for store")
  {# call gtk_tree_model_rows_reordered #}
    (toTreeModel self)
    pathPtr
    iterPtr
    newOrderArrPtr

-- -*-haskell-*-
--  GIMP Toolkit (GTK) CustomStore TreeModel
--
--  Author : Duncan Coutts
--
--  Created: 19 Sep 2005
--
--  Version $Revision: 1.1 $ from $Date: 2005/12/08 18:12:43 $
--
--  Copyright (C) 2005 Duncan Coutts
--
--  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  : custom-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Allows a custom data structure to be used with the 'TreeView'
--
module Graphics.UI.Gtk.TreeList.CustomStore (
  CustomStore(..),
  customStoreNew,
  ) where

import Monad	(liftM, when)

import System.Glib.FFI			hiding	(maybeNull)
import System.Glib.Flags
import System.Glib.GObject			(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.TreeList.TreeModel#}
{#import Graphics.UI.Gtk.TreeList.TreeIter#}
{#import Graphics.UI.Gtk.TreeList.TreePath#}
import System.Glib.StoreValue			(TMType(..), GenericValue(..)
						,valueSetGenericValue)
{#import System.Glib.GValue#}			(GValue(GValue), allocaGValue)
{#import System.Glib.GType#}			(GType)
import System.Glib.GValueTypes                  (valueSetString)

{# context lib="gtk" prefix="gtk" #}

data CustomStore = CustomStore {
    customStoreGetFlags      :: IO [TreeModelFlags],
    customStoreGetNColumns   :: IO Int,
    customStoreGetColumnType :: Int -> IO GType,
    customStoreGetIter       :: TreePath -> IO (Maybe TreeIter),              -- convert a path to an iterator
    customStoreGetPath       :: TreeIter -> IO TreePath,                      -- convert an interator to a path
    customStoreGetValue      :: TreeIter -> Int -> GValue -> IO (),           -- get the value at an iter and column
    customStoreIterNext      :: TreeIter -> IO (Maybe TreeIter),              -- following row (if any)
    customStoreIterChildren  :: Maybe TreeIter -> IO (Maybe TreeIter),        -- first child row (if any)
    customStoreIterHasChild  :: TreeIter -> IO Bool,                          -- row has any children at all
    customStoreIterNChildren :: Maybe TreeIter -> IO Int,                     -- number of children of a row
    customStoreIterNthChild  :: Maybe TreeIter -> Int -> IO (Maybe TreeIter), -- nth child row of a given row
    customStoreIterParent    :: TreeIter -> IO (Maybe TreeIter),              -- parent row of a row
    customStoreRefNode       :: TreeIter -> IO (),                            -- caching hint
    customStoreUnrefNode     :: TreeIter -> IO ()                             -- caching hint
  }

customStoreGetFlags_static :: StablePtr CustomStore -> IO CInt
customStoreGetFlags_static storePtr = do
  store <- deRefStablePtr storePtr
  liftM (fromIntegral . fromFlags) $ customStoreGetFlags store

foreign export ccall "gtk2hs_store_get_flags_impl"
  customStoreGetFlags_static :: StablePtr CustomStore -> IO CInt

customStoreGetNColumns_static :: StablePtr CustomStore -> IO CInt
customStoreGetNColumns_static storePtr = do
  store <- deRefStablePtr storePtr
  liftM fromIntegral $ customStoreGetNColumns store

foreign export ccall "gtk2hs_store_get_n_columns_impl"
  customStoreGetNColumns_static :: StablePtr CustomStore -> IO CInt

customStoreGetColumnType_static :: StablePtr CustomStore -> CInt -> IO GType
customStoreGetColumnType_static storePtr column = do
  store <- deRefStablePtr storePtr
  customStoreGetColumnType store (fromIntegral column)

foreign export ccall "gtk2hs_store_get_column_type_impl"
  customStoreGetColumnType_static :: StablePtr CustomStore -> CInt -> IO GType

customStoreGetIter_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr NativeTreePath -> IO CInt
customStoreGetIter_static storePtr iterPtr pathPtr = do
  store <- deRefStablePtr storePtr
  path <- peekTreePath pathPtr
  iter <- customStoreGetIter store path
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)

foreign export ccall "gtk2hs_store_get_iter_impl"
  customStoreGetIter_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr NativeTreePath -> IO CInt

customStoreGetPath_static :: StablePtr CustomStore -> Ptr TreeIter -> IO (Ptr NativeTreePath)
customStoreGetPath_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  path <- customStoreGetPath store iter
  NativeTreePath pathPtr <- newTreePath path
  return pathPtr

foreign export ccall "gtk2hs_store_get_path_impl"
  customStoreGetPath_static :: StablePtr CustomStore -> Ptr TreeIter -> IO (Ptr NativeTreePath)

customStoreGetValue_static :: StablePtr CustomStore -> Ptr TreeIter -> CInt -> Ptr GValue -> IO ()
customStoreGetValue_static storePtr iterPtr column gvaluePtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  customStoreGetValue store iter (fromIntegral column) (GValue gvaluePtr)

foreign export ccall "gtk2hs_store_get_value_impl"
  customStoreGetValue_static :: StablePtr CustomStore -> Ptr TreeIter -> CInt -> Ptr GValue -> IO ()

customStoreIterNext_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt
customStoreIterNext_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  iter' <- customStoreIterNext store iter
  case iter' of
    Nothing    -> return (fromBool False)
    Just iter' -> do poke iterPtr iter'
                     return (fromBool True)

foreign export ccall "gtk2hs_store_iter_next_impl"
  customStoreIterNext_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt

customStoreIterChildren_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> IO CInt
customStoreIterChildren_static storePtr iterPtr parentIterPtr = do
  store <- deRefStablePtr storePtr
  parentIter <- maybeNull peek parentIterPtr
  iter <- customStoreIterChildren store parentIter
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)

foreign export ccall "gtk2hs_store_iter_children_impl"
  customStoreIterChildren_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> IO CInt

customStoreIterHasChild_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt
customStoreIterHasChild_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  liftM fromBool $ customStoreIterHasChild store iter

foreign export ccall "gtk2hs_store_iter_has_child_impl"
  customStoreIterHasChild_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt

customStoreIterNChildren_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt
customStoreIterNChildren_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- maybeNull peek iterPtr
  liftM fromIntegral $ customStoreIterNChildren store iter

foreign export ccall "gtk2hs_store_iter_n_children_impl"
  customStoreIterNChildren_static :: StablePtr CustomStore -> Ptr TreeIter -> IO CInt

customStoreIterNthChild_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt
customStoreIterNthChild_static storePtr iterPtr parentIterPtr n = do
  store <- deRefStablePtr storePtr
  parentIter <- maybeNull peek parentIterPtr
  iter <- customStoreIterNthChild store parentIter (fromIntegral n)
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)

foreign export ccall "gtk2hs_store_iter_nth_child_impl"
  customStoreIterNthChild_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt

customStoreIterParent_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> IO CInt
customStoreIterParent_static  storePtr iterPtr childIterPtr = do
  store <- deRefStablePtr storePtr
  childIter <- peek childIterPtr
  iter <- customStoreIterParent store childIter
  case iter of
    Nothing   -> return (fromBool False)
    Just iter -> do poke iterPtr iter
                    return (fromBool True)

foreign export ccall "gtk2hs_store_iter_parent_impl"
  customStoreIterParent_static :: StablePtr CustomStore -> Ptr TreeIter -> Ptr TreeIter -> IO CInt

customStoreRefNode_static :: StablePtr CustomStore -> Ptr TreeIter -> IO ()
customStoreRefNode_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  customStoreRefNode store iter

foreign export ccall "gtk2hs_store_ref_node_impl"
  customStoreRefNode_static :: StablePtr CustomStore -> Ptr TreeIter -> IO ()

customStoreUnrefNode_static :: StablePtr CustomStore -> Ptr TreeIter -> IO ()
customStoreUnrefNode_static storePtr iterPtr = do
  store <- deRefStablePtr storePtr
  iter <- peek iterPtr
  customStoreUnrefNode store iter

foreign export ccall "gtk2hs_store_unref_node_impl"
  customStoreUnrefNode_static :: StablePtr CustomStore -> Ptr TreeIter -> IO ()

foreign import ccall unsafe "gtk2hs_store_new"
  gtk2hs_store_new :: StablePtr CustomStore -> IO (Ptr TreeModel)

customStoreNew :: CustomStore -> IO TreeModel
customStoreNew impl = do
  implPtr <- newStablePtr impl
  makeNewGObject mkTreeModel $
    gtk2hs_store_new implPtr

maybeNull :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybeNull marshal ptr
  | ptr == nullPtr = return Nothing
  | otherwise      = liftM Just (marshal ptr)


Fix webSettingsFantasyFontFamily attr

Fix webSettingsFantasyFontFamily attr

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
-----------------------------------------------------------------------------
--  Module      :  Graphics.UI.Gtk.WebKit.WebSettings
--  Author      :  Cjacker Huang
--  Copyright   :  (c) 2009 Cjacker Huang <jzhuang@redflag-linux.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)
--
-- Control the behaviour of a 'WebView'
-----------------------------------------------------------------------------

module Graphics.UI.Gtk.WebKit.WebSettings (
-- * Types
  WebSettings,
  WebSettingsClass,
  EditingBehavior,

-- * Constructors
  webSettingsNew,

-- * Methods
  webSettingsCopy,
  webSettingsGetUserAgent,

-- * Attributes
  webSettingsAutoLoadImages,
  webSettingsAutoShrinkImages,
  webSettingsCursiveFontFamily,
  webSettingsDefaultEncoding,
  webSettingsDefaultFontFamily,
  webSettingsDefaultFontSize,
  webSettingsDefaultMonospaceFontSize,
  webSettingsEditingBehavior,
  webSettingsEnableCaretBrowsing,
  webSettingsEnableDeveloperExtras,
#if WEBKIT_CHECK_VERSION (1,1,16)
  webSettingsEnableDomPaste,
#endif
  webSettingsEnableHtml5Database,
  webSettingsEnableHtml5LocalStorage,
  webSettingsEnableOfflineWebApplicationCache,
  webSettingsEnablePlugins,
  webSettingsEnablePrivateBrowsing,
  webSettingsEnableScripts,
  webSettingsEnableSpellChecking,
  webSettingsEnableUniversalAccessFromFileUris,
  webSettingsEnableXssAuditor,
  webSettingsEnforce96Dpi,
  webSettingsFantasyFontFamily,
  webSettingsJSCanOpenWindowAuto,
  webSettingsMinimumFontSize,
  webSettingsMinimumLogicalFontSize,
  webSettingsMonospaceFontFamily,
  webSettingsPrintBackgrounds,
  webSettingsResizableTextAreas,
  webSettingsSansFontFamily,
  webSettingsSerifFontFamily,
  webSettingsSpellCheckingLang,
#if WEBKIT_CHECK_VERSION (1,1,17)
  webSettingsTabKeyCyclesThroughElements,
#endif
#if WEBKIT_CHECK_VERSION (1,1,18)
  webSettingsEnableDefaultContextMenu,
  webSettingsEnablePageCache,
#endif
  webSettingsUserAgent,
  webSettingsUserStylesheetUri,
  webSettingsZoomStep,
  webSettingsEnableSiteSpecificQuirks,
#if WEBKIT_CHECK_VERSION (1,1,23)
  webSettingsEnableSpatialNavigation,
#endif
) where

import Control.Monad		(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.GError
import System.Glib.Properties
import System.Glib.Attributes
import Graphics.UI.Gtk.Gdk.Events

{#import Graphics.UI.Gtk.Abstract.Object#}	(makeNewObject)
{#import Graphics.UI.Gtk.WebKit.Types#}
{#import System.Glib.GObject#}

{#context lib="webkit" prefix ="webkit"#}

{#enum EditingBehavior {underscoreToCase}#}
------------------
-- Constructors

-- | Create a new 'WebSettings' instance.
--
-- A 'WebSettings' can be applied to a 'WebView'
-- to control the to be used text encoding, color, font size,
-- printing mode,script support, loading of images and various other things.
webSettingsNew :: IO WebSettings
webSettingsNew =
    constructNewGObject mkWebSettings $ {#call web_settings_new#}

-- | Copy an existing 'WebSettings' instance.
webSettingsCopy ::
    WebSettingsClass self => self
 -> IO WebSettings
webSettingsCopy websettings =
    constructNewGObject mkWebSettings $ {#call web_settings_copy#} (toWebSettings websettings)

-- | Return the User-Agent string currently used.
webSettingsGetUserAgent ::
    WebSettingsClass self => self
 -> IO (Maybe String) -- ^ User-Agent string or @Nothing@ in case failed.
webSettingsGetUserAgent websettings =
    {#call web_settings_get_user_agent#} (toWebSettings websettings) >>= maybePeek peekCString

-- | Load images automatically
--
-- Default value: True
webSettingsAutoLoadImages :: (WebSettingsClass self) => Attr self Bool
webSettingsAutoLoadImages = newAttrFromBoolProperty "auto-load-images"

-- | Automatically shrink standalone images to fit
--
-- Default value: True
webSettingsAutoShrinkImages :: (WebSettingsClass self) => Attr self Bool
webSettingsAutoShrinkImages = newAttrFromBoolProperty "auto-shrink-images"

-- | The default Cursive font family used to display text
--
-- Default value "serif"
webSettingsCursiveFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsCursiveFontFamily = newAttrFromStringProperty "cursive-font-family"

-- | The default encoding used to display text
--
-- Default value "iso-8859-1"

webSettingsDefaultEncoding :: (WebSettingsClass self) => Attr self String
webSettingsDefaultEncoding = newAttrFromStringProperty "default-encoding"

-- | The default font family used to display text
--
-- Default value: "sans-serif"

webSettingsDefaultFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsDefaultFontFamily = newAttrFromStringProperty "default-font-family"

-- | The default font size used to display text
--
-- Default value: >=5

webSettingsDefaultFontSize :: (WebSettingsClass self) => Attr self Int
webSettingsDefaultFontSize = newAttrFromIntProperty "default-font-size"

-- | The default font size used to display monospace text
--
-- Allowed values: >= 5
--
-- Default value: 10

webSettingsDefaultMonospaceFontSize :: (WebSettingsClass self) => Attr self Int
webSettingsDefaultMonospaceFontSize = newAttrFromIntProperty "default-monospace-font-size"

-- | This settings controls various editing behaviors
webSettingsEditingBehavior :: (WebSettingsClass self) => Attr self EditingBehavior
webSettingsEditingBehavior = newAttrFromEnumProperty "editing-behavior"
        {#call pure unsafe webkit_editing_behavior_get_type#}
-- | Whether to enable caret browsing mode.
webSettingsEnableCaretBrowsing :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableCaretBrowsing = newAttrFromBoolProperty "enable-caret-browsing"

-- | Whether developer extensions should be enabled.
--
-- This enables, for now, the 'WebInspector'
webSettingsEnableDeveloperExtras :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableDeveloperExtras = newAttrFromBoolProperty "enable-developer-extras"

#if WEBKIT_CHECK_VERSION (1,1,16)
-- | Whether to enable DOM paste. If set to 'True', document.execCommand("Paste") will correctly execute
-- and paste content of the clipboard.
--
-- Default value: 'False'
--
-- * Since 1.1.16
webSettingsEnableDomPaste :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableDomPaste = newAttrFromBoolProperty "enable-dom-paste"
#endif

-- | Whether to enable HTML5 client-side SQL database support.
webSettingsEnableHtml5Database :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableHtml5Database = newAttrFromBoolProperty "enable-html5-database"

-- | Whether to enable HTML5 localStorage support.
webSettingsEnableHtml5LocalStorage :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableHtml5LocalStorage = newAttrFromBoolProperty "enable-html5-local-storage"

-- | Whether to enable HTML5 offline web application cache support.
webSettingsEnableOfflineWebApplicationCache :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableOfflineWebApplicationCache = newAttrFromBoolProperty "enable-offline-web-application-cache"

-- | Enable embedded plugin objects.
webSettingsEnablePlugins :: (WebSettingsClass self) => Attr self Bool
webSettingsEnablePlugins = newAttrFromBoolProperty "enable-plugins"

-- | Whether to enable private browsing mode.
webSettingsEnablePrivateBrowsing :: (WebSettingsClass self) => Attr self Bool
webSettingsEnablePrivateBrowsing = newAttrFromBoolProperty "enable-private-browsing"

-- | Enable embedded scripting languages
webSettingsEnableScripts :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableScripts = newAttrFromBoolProperty "enable-scripts"

-- | Whether to enable speel checking while typing.
webSettingsEnableSpellChecking :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableSpellChecking = newAttrFromBoolProperty "enable-spell-checking"

-- | Whether to allow files loaded through file:// URLs universal access to all pages.
webSettingsEnableUniversalAccessFromFileUris :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableUniversalAccessFromFileUris = newAttrFromBoolProperty "enable-universal-access-from-file-uris"

-- | Whether to enable the XSS Auditor.
--
-- This feature filters some kinds of reflective XSS attacks on vulnerable web sites.
webSettingsEnableXssAuditor :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableXssAuditor = newAttrFromBoolProperty "enable-xss-auditor"

-- | Enforce a resolution of 96 DPI.
webSettingsEnforce96Dpi :: (WebSettingsClass self) => Attr self Bool
webSettingsEnforce96Dpi = newAttrFromBoolProperty "enforce-96-dpi"

-- | The default Fantasy font family used to display text
webSettingsFantasyFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsFantasyFontFamily = newAttrFromStringProperty "fantasy-font-family"

-- | Whether JavaScript can open popup windows automatically without user intervention.
webSettingsJSCanOpenWindowAuto :: (WebSettingsClass self) => Attr self Bool
webSettingsJSCanOpenWindowAuto = newAttrFromBoolProperty "javascript-can-open-windows-automatically"

-- | The minimum font size used to display text.
--
-- Allowed values: >=1
--
-- Default value: 5
webSettingsMinimumFontSize :: (WebSettingsClass self) => Attr self Int
webSettingsMinimumFontSize = newAttrFromIntProperty "minimum-font-size"

-- | The minimum logical font size used to display text
--
-- Allowed values: >=1
--
-- Default value: 5
webSettingsMinimumLogicalFontSize :: (WebSettingsClass self) => Attr self Int
webSettingsMinimumLogicalFontSize = newAttrFromIntProperty "minimum-logical-font-size"

-- | The default font family used to display monospace text.
--
-- Default value: "monospace"
webSettingsMonospaceFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsMonospaceFontFamily = newAttrFromStringProperty "monospace-font-family"

-- | Whether background images should be printed
--
-- Default value: True
webSettingsPrintBackgrounds :: (WebSettingsClass self) => Attr self Bool
webSettingsPrintBackgrounds = newAttrFromBoolProperty "print-backgrounds"

-- | Whether text areas are resizable
--
-- Default value : True
webSettingsResizableTextAreas :: (WebSettingsClass self) => Attr self Bool
webSettingsResizableTextAreas =  newAttrFromBoolProperty "resizable-text-areas"

-- | The default Sans Serif font family used to display text
--
-- Default value "sans-serif"
webSettingsSansFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsSansFontFamily = newAttrFromStringProperty "sans-serif-font-family"

-- | The default Serif font family used to display text
--
-- Default value: "serif"
webSettingsSerifFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsSerifFontFamily = newAttrFromStringProperty "serif-font-family"

-- | The languages to be used for spell checking, separated by commas
--
-- The locale string typically is in the form lang_COUNTRY,
-- where lang is an ISO-639 language code, and COUNTRY is an ISO-3166 country code.
-- For instance, sv_FI for Swedish as written in Finland or pt_BR for Portuguese as written in Brazil.
--
-- If no value is specified then the value returned by gtk_get_default_language will be used.
--
-- Default value: @Nothing@
webSettingsSpellCheckingLang :: (WebSettingsClass self) => Attr self (Maybe String)
webSettingsSpellCheckingLang = newAttrFromMaybeStringProperty "spell-checking-languages"

#if WEBKIT_CHECK_VERSION (1,1,17)
-- | Whether the tab key cycles through elements on the page.
--
-- If flag is 'True', pressing the tab key will focus the next element in the @webView@. If flag is 'False',
-- the @webView@ will interpret tab key presses as normal key presses. If the selected element is
-- editable, the tab key will cause the insertion of a tab character.
--
-- Default value: 'True'
--
-- * Since 1.1.17
webSettingsTabKeyCyclesThroughElements :: (WebSettingsClass self) => Attr self Bool
webSettingsTabKeyCyclesThroughElements = newAttrFromBoolProperty "tab-key-cycles-through-elements"
#endif

#if WEBKIT_CHECK_VERSION (1,1,18)
-- | Whether right-clicks should be handled automatically to create, and display the context
-- menu. Turning this off will make WebKitGTK+ not emit the populate-popup signal. Notice that the
-- default button press event handler may still handle right clicks for other reasons, such as in-page
-- context menus, or right-clicks that are handled by the page itself.
--
-- Default value: 'True'
--
-- * Since 1.1.18
webSettingsEnableDefaultContextMenu :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableDefaultContextMenu = newAttrFromBoolProperty "enable-default-context-menu"

-- | Enable or disable the page cache. Disabling the page cache is generally only useful for special
-- circumstances like low-memory scenarios or special purpose applications like static HTML
-- viewers. This setting only controls the Page Cache, this cache is different than the disk-based or
-- memory-based traditional resource caches, its point is to make going back and forth between pages
-- much faster. For details about the different types of caches and their purposes see:
-- http://webkit.org/ blog/427/webkit-page-cache-i-the-basics/
--
-- Default value: 'False'
--
-- * Since 1.1.18
webSettingsEnablePageCache :: (WebSettingsClass self) => Attr self Bool
webSettingsEnablePageCache = newAttrFromBoolProperty "enable-page-cache"
#endif

-- | The User-Agent string used by WebKit
--
-- This will return a default User-Agent string if a custom string wasn't provided by the application.
-- Setting this property to a NULL value or an empty string will result in
-- the User-Agent string being reset to the default value.
--
-- Default value: \"Mozilla/5.0 (X11; U; Linux x86_64; c) AppleWebKit/531.2+ (KHTML, like Gecko) Safari/531.2+\"

webSettingsUserAgent :: (WebSettingsClass self) => Attr self String
webSettingsUserAgent = newAttrFromStringProperty "user-agent"

-- | The URI of a stylesheet that is applied to every page.
--
-- Default value: @Nothing@

webSettingsUserStylesheetUri :: (WebSettingsClass self) => Attr self (Maybe String)
webSettingsUserStylesheetUri = newAttrFromMaybeStringProperty "user-stylesheet-uri"

-- | The value by which the zoom level is changed when zooming in or out
--
-- Allowed values: >= 0
--
-- Default value: 0.1
webSettingsZoomStep :: (WebSettingsClass self) => Attr self Float
webSettingsZoomStep = newAttrFromFloatProperty "zoom-step"

-- | Enables the site-specific compatibility workarounds.
--
-- Default value: False
webSettingsEnableSiteSpecificQuirks :: WebSettingsClass self => Attr self Bool
webSettingsEnableSiteSpecificQuirks = newAttrFromBoolProperty "enable-site-specific-quirks"

#if WEBKIT_CHECK_VERSION (1,1,23)
-- | Whether to enable the Spatial Navigation. This feature consists in the ability to navigate between
-- focusable elements in a Web page, such as hyperlinks and form controls, by using Left, Right, Up and
-- Down arrow keys. For example, if an user presses the Right key, heuristics determine whether there
-- is an element he might be trying to reach towards the right, and if there are multiple elements,
-- which element he probably wants.
--
-- Default value: 'False'
--
-- * Since 1.1.23
webSettingsEnableSpatialNavigation :: WebSettingsClass self => Attr self Bool
webSettingsEnableSpatialNavigation = newAttrFromBoolProperty "enable-spatial-navigation"
#endif

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
-----------------------------------------------------------------------------
--  Module      :  Graphics.UI.Gtk.WebKit.WebSettings
--  Author      :  Cjacker Huang
--  Copyright   :  (c) 2009 Cjacker Huang <jzhuang@redflag-linux.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)
--
-- Control the behaviour of a 'WebView'
-----------------------------------------------------------------------------

module Graphics.UI.Gtk.WebKit.WebSettings (
-- * Types
  WebSettings,
  WebSettingsClass,
  EditingBehavior,

-- * Constructors
  webSettingsNew,

-- * Methods
  webSettingsCopy,
  webSettingsGetUserAgent,

-- * Attributes
  webSettingsAutoLoadImages,
  webSettingsAutoShrinkImages,
  webSettingsCursiveFontFamily,
  webSettingsDefaultEncoding,
  webSettingsDefaultFontFamily,
  webSettingsDefaultFontSize,
  webSettingsDefaultMonospaceFontSize,
  webSettingsEditingBehavior,
  webSettingsEnableCaretBrowsing,
  webSettingsEnableDeveloperExtras,
#if WEBKIT_CHECK_VERSION (1,1,16)
  webSettingsEnableDomPaste,
#endif
  webSettingsEnableHtml5Database,
  webSettingsEnableHtml5LocalStorage,
  webSettingsEnableOfflineWebApplicationCache,
  webSettingsEnablePlugins,
  webSettingsEnablePrivateBrowsing,
  webSettingsEnableScripts,
  webSettingsEnableSpellChecking,
  webSettingsEnableUniversalAccessFromFileUris,
  webSettingsEnableXssAuditor,
  webSettingsEnforce96Dpi,
  webSettingsFantasyFontFamily,
  webSettingsJSCanOpenWindowAuto,
  webSettingsMinimumFontSize,
  webSettingsMinimumLogicalFontSize,
  webSettingsMonospaceFontFamily,
  webSettingsPrintBackgrounds,
  webSettingsResizableTextAreas,
  webSettingsSansFontFamily,
  webSettingsSerifFontFamily,
  webSettingsSpellCheckingLang,
#if WEBKIT_CHECK_VERSION (1,1,17)
  webSettingsTabKeyCyclesThroughElements,
#endif
#if WEBKIT_CHECK_VERSION (1,1,18)
  webSettingsEnableDefaultContextMenu,
  webSettingsEnablePageCache,
#endif
  webSettingsUserAgent,
  webSettingsUserStylesheetUri,
  webSettingsZoomStep,
  webSettingsEnableSiteSpecificQuirks,
#if WEBKIT_CHECK_VERSION (1,1,23)
  webSettingsEnableSpatialNavigation,
#endif
) where

import Control.Monad		(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.GError
import System.Glib.Properties
import System.Glib.Attributes
import Graphics.UI.Gtk.Gdk.Events

{#import Graphics.UI.Gtk.Abstract.Object#}	(makeNewObject)
{#import Graphics.UI.Gtk.WebKit.Types#}
{#import System.Glib.GObject#}

{#context lib="webkit" prefix ="webkit"#}

{#enum EditingBehavior {underscoreToCase}#}
------------------
-- Constructors

-- | Create a new 'WebSettings' instance.
--
-- A 'WebSettings' can be applied to a 'WebView'
-- to control the to be used text encoding, color, font size,
-- printing mode,script support, loading of images and various other things.
webSettingsNew :: IO WebSettings
webSettingsNew =
    constructNewGObject mkWebSettings $ {#call web_settings_new#}

-- | Copy an existing 'WebSettings' instance.
webSettingsCopy ::
    WebSettingsClass self => self
 -> IO WebSettings
webSettingsCopy websettings =
    constructNewGObject mkWebSettings $ {#call web_settings_copy#} (toWebSettings websettings)

-- | Return the User-Agent string currently used.
webSettingsGetUserAgent ::
    WebSettingsClass self => self
 -> IO (Maybe String) -- ^ User-Agent string or @Nothing@ in case failed.
webSettingsGetUserAgent websettings =
    {#call web_settings_get_user_agent#} (toWebSettings websettings) >>= maybePeek peekCString

-- | Load images automatically
--
-- Default value: True
webSettingsAutoLoadImages :: (WebSettingsClass self) => Attr self Bool
webSettingsAutoLoadImages = newAttrFromBoolProperty "auto-load-images"

-- | Automatically shrink standalone images to fit
--
-- Default value: True
webSettingsAutoShrinkImages :: (WebSettingsClass self) => Attr self Bool
webSettingsAutoShrinkImages = newAttrFromBoolProperty "auto-shrink-images"

-- | The default Cursive font family used to display text
--
-- Default value "serif"
webSettingsCursiveFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsCursiveFontFamily = newAttrFromStringProperty "cursive-font-family"

-- | The default encoding used to display text
--
-- Default value "iso-8859-1"

webSettingsDefaultEncoding :: (WebSettingsClass self) => Attr self String
webSettingsDefaultEncoding = newAttrFromStringProperty "default-encoding"

-- | The default font family used to display text
--
-- Default value: "sans-serif"

webSettingsDefaultFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsDefaultFontFamily = newAttrFromStringProperty "default-font-family"

-- | The default font size used to display text
--
-- Default value: >=5

webSettingsDefaultFontSize :: (WebSettingsClass self) => Attr self Int
webSettingsDefaultFontSize = newAttrFromIntProperty "default-font-size"

-- | The default font size used to display monospace text
--
-- Allowed values: >= 5
--
-- Default value: 10

webSettingsDefaultMonospaceFontSize :: (WebSettingsClass self) => Attr self Int
webSettingsDefaultMonospaceFontSize = newAttrFromIntProperty "default-monospace-font-size"

-- | This settings controls various editing behaviors
webSettingsEditingBehavior :: (WebSettingsClass self) => Attr self EditingBehavior
webSettingsEditingBehavior = newAttrFromEnumProperty "editing-behavior"
        {#call pure unsafe webkit_editing_behavior_get_type#}
-- | Whether to enable caret browsing mode.
webSettingsEnableCaretBrowsing :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableCaretBrowsing = newAttrFromBoolProperty "enable-caret-browsing"

-- | Whether developer extensions should be enabled.
--
-- This enables, for now, the 'WebInspector'
webSettingsEnableDeveloperExtras :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableDeveloperExtras = newAttrFromBoolProperty "enable-developer-extras"

#if WEBKIT_CHECK_VERSION (1,1,16)
-- | Whether to enable DOM paste. If set to 'True', document.execCommand("Paste") will correctly execute
-- and paste content of the clipboard.
--
-- Default value: 'False'
--
-- * Since 1.1.16
webSettingsEnableDomPaste :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableDomPaste = newAttrFromBoolProperty "enable-dom-paste"
#endif

-- | Whether to enable HTML5 client-side SQL database support.
webSettingsEnableHtml5Database :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableHtml5Database = newAttrFromBoolProperty "enable-html5-database"

-- | Whether to enable HTML5 localStorage support.
webSettingsEnableHtml5LocalStorage :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableHtml5LocalStorage = newAttrFromBoolProperty "enable-html5-local-storage"

-- | Whether to enable HTML5 offline web application cache support.
webSettingsEnableOfflineWebApplicationCache :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableOfflineWebApplicationCache = newAttrFromBoolProperty "enable-offline-web-application-cache"

-- | Enable embedded plugin objects.
webSettingsEnablePlugins :: (WebSettingsClass self) => Attr self Bool
webSettingsEnablePlugins = newAttrFromBoolProperty "enable-plugins"

-- | Whether to enable private browsing mode.
webSettingsEnablePrivateBrowsing :: (WebSettingsClass self) => Attr self Bool
webSettingsEnablePrivateBrowsing = newAttrFromBoolProperty "enable-private-browsing"

-- | Enable embedded scripting languages
webSettingsEnableScripts :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableScripts = newAttrFromBoolProperty "enable-scripts"

-- | Whether to enable speel checking while typing.
webSettingsEnableSpellChecking :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableSpellChecking = newAttrFromBoolProperty "enable-spell-checking"

-- | Whether to allow files loaded through file:// URLs universal access to all pages.
webSettingsEnableUniversalAccessFromFileUris :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableUniversalAccessFromFileUris = newAttrFromBoolProperty "enable-universal-access-from-file-uris"

-- | Whether to enable the XSS Auditor.
--
-- This feature filters some kinds of reflective XSS attacks on vulnerable web sites.
webSettingsEnableXssAuditor :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableXssAuditor = newAttrFromBoolProperty "enable-xss-auditor"

-- | Enforce a resolution of 96 DPI.
webSettingsEnforce96Dpi :: (WebSettingsClass self) => Attr self Bool
webSettingsEnforce96Dpi = newAttrFromBoolProperty "enforce-96-dpi"

-- | The default Fantasy font family used to display text
webSettingsFantasyFontFamily :: (WebSettingsClass self) => Attr self Bool
webSettingsFantasyFontFamily = newAttrFromBoolProperty "fantasy-font-family"

-- | Whether JavaScript can open popup windows automatically without user intervention.
webSettingsJSCanOpenWindowAuto :: (WebSettingsClass self) => Attr self Bool
webSettingsJSCanOpenWindowAuto = newAttrFromBoolProperty "javascript-can-open-windows-automatically"

-- | The minimum font size used to display text.
--
-- Allowed values: >=1
--
-- Default value: 5
webSettingsMinimumFontSize :: (WebSettingsClass self) => Attr self Int
webSettingsMinimumFontSize = newAttrFromIntProperty "minimum-font-size"

-- | The minimum logical font size used to display text
--
-- Allowed values: >=1
--
-- Default value: 5
webSettingsMinimumLogicalFontSize :: (WebSettingsClass self) => Attr self Int
webSettingsMinimumLogicalFontSize = newAttrFromIntProperty "minimum-logical-font-size"

-- | The default font family used to display monospace text.
--
-- Default value: "monospace"
webSettingsMonospaceFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsMonospaceFontFamily = newAttrFromStringProperty "monospace-font-family"

-- | Whether background images should be printed
--
-- Default value: True
webSettingsPrintBackgrounds :: (WebSettingsClass self) => Attr self Bool
webSettingsPrintBackgrounds = newAttrFromBoolProperty "print-backgrounds"

-- | Whether text areas are resizable
--
-- Default value : True
webSettingsResizableTextAreas :: (WebSettingsClass self) => Attr self Bool
webSettingsResizableTextAreas =  newAttrFromBoolProperty "resizable-text-areas"

-- | The default Sans Serif font family used to display text
--
-- Default value "sans-serif"
webSettingsSansFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsSansFontFamily = newAttrFromStringProperty "sans-serif-font-family"

-- | The default Serif font family used to display text
--
-- Default value: "serif"
webSettingsSerifFontFamily :: (WebSettingsClass self) => Attr self String
webSettingsSerifFontFamily = newAttrFromStringProperty "serif-font-family"

-- | The languages to be used for spell checking, separated by commas
--
-- The locale string typically is in the form lang_COUNTRY,
-- where lang is an ISO-639 language code, and COUNTRY is an ISO-3166 country code.
-- For instance, sv_FI for Swedish as written in Finland or pt_BR for Portuguese as written in Brazil.
--
-- If no value is specified then the value returned by gtk_get_default_language will be used.
--
-- Default value: @Nothing@
webSettingsSpellCheckingLang :: (WebSettingsClass self) => Attr self (Maybe String)
webSettingsSpellCheckingLang = newAttrFromMaybeStringProperty "spell-checking-languages"

#if WEBKIT_CHECK_VERSION (1,1,17)
-- | Whether the tab key cycles through elements on the page.
--
-- If flag is 'True', pressing the tab key will focus the next element in the @webView@. If flag is 'False',
-- the @webView@ will interpret tab key presses as normal key presses. If the selected element is
-- editable, the tab key will cause the insertion of a tab character.
--
-- Default value: 'True'
--
-- * Since 1.1.17
webSettingsTabKeyCyclesThroughElements :: (WebSettingsClass self) => Attr self Bool
webSettingsTabKeyCyclesThroughElements = newAttrFromBoolProperty "tab-key-cycles-through-elements"
#endif

#if WEBKIT_CHECK_VERSION (1,1,18)
-- | Whether right-clicks should be handled automatically to create, and display the context
-- menu. Turning this off will make WebKitGTK+ not emit the populate-popup signal. Notice that the
-- default button press event handler may still handle right clicks for other reasons, such as in-page
-- context menus, or right-clicks that are handled by the page itself.
--
-- Default value: 'True'
--
-- * Since 1.1.18
webSettingsEnableDefaultContextMenu :: (WebSettingsClass self) => Attr self Bool
webSettingsEnableDefaultContextMenu = newAttrFromBoolProperty "enable-default-context-menu"

-- | Enable or disable the page cache. Disabling the page cache is generally only useful for special
-- circumstances like low-memory scenarios or special purpose applications like static HTML
-- viewers. This setting only controls the Page Cache, this cache is different than the disk-based or
-- memory-based traditional resource caches, its point is to make going back and forth between pages
-- much faster. For details about the different types of caches and their purposes see:
-- http://webkit.org/ blog/427/webkit-page-cache-i-the-basics/
--
-- Default value: 'False'
--
-- * Since 1.1.18
webSettingsEnablePageCache :: (WebSettingsClass self) => Attr self Bool
webSettingsEnablePageCache = newAttrFromBoolProperty "enable-page-cache"
#endif

-- | The User-Agent string used by WebKit
--
-- This will return a default User-Agent string if a custom string wasn't provided by the application.
-- Setting this property to a NULL value or an empty string will result in
-- the User-Agent string being reset to the default value.
--
-- Default value: \"Mozilla/5.0 (X11; U; Linux x86_64; c) AppleWebKit/531.2+ (KHTML, like Gecko) Safari/531.2+\"

webSettingsUserAgent :: (WebSettingsClass self) => Attr self String
webSettingsUserAgent = newAttrFromStringProperty "user-agent"

-- | The URI of a stylesheet that is applied to every page.
--
-- Default value: @Nothing@

webSettingsUserStylesheetUri :: (WebSettingsClass self) => Attr self (Maybe String)
webSettingsUserStylesheetUri = newAttrFromMaybeStringProperty "user-stylesheet-uri"

-- | The value by which the zoom level is changed when zooming in or out
--
-- Allowed values: >= 0
--
-- Default value: 0.1
webSettingsZoomStep :: (WebSettingsClass self) => Attr self Float
webSettingsZoomStep = newAttrFromFloatProperty "zoom-step"

-- | Enables the site-specific compatibility workarounds.
--
-- Default value: False
webSettingsEnableSiteSpecificQuirks :: WebSettingsClass self => Attr self Bool
webSettingsEnableSiteSpecificQuirks = newAttrFromBoolProperty "enable-site-specific-quirks"

#if WEBKIT_CHECK_VERSION (1,1,23)
-- | Whether to enable the Spatial Navigation. This feature consists in the ability to navigate between
-- focusable elements in a Web page, such as hyperlinks and form controls, by using Left, Right, Up and
-- Down arrow keys. For example, if an user presses the Right key, heuristics determine whether there
-- is an element he might be trying to reach towards the right, and if there are multiple elements,
-- which element he probably wants.
--
-- Default value: 'False'
--
-- * Since 1.1.23
webSettingsEnableSpatialNavigation :: WebSettingsClass self => Attr self Bool
webSettingsEnableSpatialNavigation = newAttrFromBoolProperty "enable-spatial-navigation"
#endif


fix build failure on ghc-7.4 (Eq constraints)

Media/Streaming/GStreamer/Core/Buffer.chs:216:13:
    Could not deduce (Eq numT) arising from a use of `/='
    from the context (BufferClass bufferT, Integral intT, Num numT)
      bound by the type signature for
                 marshalGetNum :: (BufferClass bufferT, Integral intT, Num numT) =>
                                  (Ptr Buffer -> IO intT) -> numT -> bufferT -> Maybe numT
      at Media/Streaming/GStreamer/Core/Buffer.chs:(213,1)-(218,22)
    Possible fix:
      add (Eq numT) to the context of
        the type signature for
          marshalGetNum :: (BufferClass bufferT, Integral intT, Num numT) =>
           (Ptr Buffer -> IO intT) -> numT -> bufferT -> Maybe numT
           In the expression: n /= invalid
           In the expression: if n /= invalid then Just n else Nothing
   In the expression:
       let
            n = fromIntegral
                $ unsafePerformIO $ withMiniObject (toBuffer buffer) getAction
       in if n /= invalid then Just n else Nothing

{-# 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)
--
--  Data-passing buffer type, supporting sub-buffers.
module Media.Streaming.GStreamer.Core.Buffer (

-- * Types

  -- | 'Buffer's are the basic unit of data transfer in GStreamer. The
  --   'Buffer' type provides all the state necessary to define a
  --   region of memory as part of a stream. Sub-buffers are also
  --   supported, allowing a smaller region of a 'Buffer' to become its
  --   own 'Buffer', with mechansims in place to ensure that neither
  --   memory space goes away prematurely.
  Buffer,
  BufferClass,
  castToBuffer,
  gTypeBuffer,

  BufferFlags(..),

-- * Buffer Operations
  bufferOffsetNone,
  bufferGetFlags,
  bufferGetFlagsM,
  bufferSetFlagsM,
  bufferUnsetFlagsM,
  bufferGetSize,
  bufferGetSizeM,
#if __GLASGOW_HASKELL__ >= 606
  bufferGetData,
  bufferGetDataM,
  bufferSetDataM,
#endif
  unsafeBufferGetPtrM,
  bufferGetTimestamp,
  bufferGetTimestampM,
  bufferSetTimestampM,
  bufferGetDuration,
  bufferGetDurationM,
  bufferSetDurationM,
  bufferGetCaps,
  bufferGetCapsM,
  bufferSetCapsM,
  bufferGetOffset,
  bufferGetOffsetM,
  bufferSetOffsetM,
  bufferGetOffsetEnd,
  bufferGetOffsetEndM,
  bufferSetOffsetEndM,
  bufferIsDiscont,
  bufferIsDiscontM,

  bufferCreateEmpty,
  bufferCreate,
  bufferCreateSub,

  bufferIsSpanFast,
  bufferSpan,
  bufferMerge

  ) where

import Control.Monad ( liftM
                     , when )
import Control.Monad.Trans
#if __GLASGOW_HASKELL__ >= 606
import qualified Data.ByteString as BS
#if __GLASGOW_HASKELL__ < 608
#define OLD_BYTESTRING
#endif
#endif

{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.FFI

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

-- | Get the flags set on @buffer@.
bufferGetFlags :: BufferClass bufferT
               => bufferT       -- ^ @buffer@ - a 'Buffer'
               -> [BufferFlags] -- ^ the flags set on @buffer@
bufferGetFlags = mkMiniObjectGetFlags

-- | Get the flags set on the current 'Buffer'.
bufferGetFlagsM :: (BufferClass bufferT, MonadIO m)
                => MiniObjectT bufferT m [BufferFlags] -- ^ the flags set on the current 'Buffer'
bufferGetFlagsM = mkMiniObjectGetFlagsM

-- | Set flags on the current 'Buffer'.
bufferSetFlagsM :: (BufferClass bufferT, MonadIO m)
                => [BufferFlags]            -- ^ @flags@ - the flags to set on the current 'Buffer'
                -> MiniObjectT bufferT m ()
bufferSetFlagsM = mkMiniObjectSetFlagsM

-- | Unset flags on the current 'Buffer'.
bufferUnsetFlagsM :: (BufferClass bufferT, MonadIO m)
                  => [BufferFlags]                    -- ^ @flags@ - the flags to unset on the current 'Buffer'
                  -> MiniObjectT bufferT m ()
bufferUnsetFlagsM = mkMiniObjectUnsetFlagsM

-- | Get @buffer@'s size in bytes.
bufferGetSize :: BufferClass bufferT
              => bufferT -- ^ @buffer@ - a 'Buffer'
              -> Word    -- ^ the size of @buffer@ in bytes
bufferGetSize buffer =
    fromIntegral $ unsafePerformIO $
        withMiniObject buffer {# get GstBuffer->size #}

marshalBufferM :: (BufferClass bufferT, MonadIO m)
               => (Ptr Buffer -> IO a)
               -> MiniObjectT bufferT m a
marshalBufferM action = do
  ptr <- askMiniObjectPtr
  liftIO $ action $ castPtr ptr

-- | Get the size of the current 'Buffer' in bytes.
bufferGetSizeM :: (BufferClass bufferT, MonadIO m)
               => MiniObjectT bufferT m Word -- ^ the size of the current 'Buffer' in bytes
bufferGetSizeM =
    liftM fromIntegral $
        marshalBufferM {# get GstBuffer->size #}

#if __GLASGOW_HASKELL__ >= 606
-- | Make an O(n) copy of the data stored in @buffer@.
bufferGetData :: BufferClass bufferT
              => bufferT       -- ^ @buffer@ - a 'Buffer'
              -> BS.ByteString -- ^ the data stored in @buffer@
bufferGetData buffer =
    unsafePerformIO $ withMiniObject buffer $ \bufferPtr ->
        do ptr <- {# get GstBuffer->data #} bufferPtr
           size <- {# get GstBuffer->size #} bufferPtr
#ifdef OLD_BYTESTRING
           BS.copyCStringLen (castPtr ptr, fromIntegral size)
#else
           BS.packCStringLen (castPtr ptr, fromIntegral size)
#endif

-- | Make an O(n) copy of the current 'Buffer'.
bufferGetDataM :: (BufferClass bufferT, MonadIO m)
               => MiniObjectT bufferT m BS.ByteString -- ^ the data stored in the current 'Buffer'
bufferGetDataM =
    marshalBufferM $ \bufferPtr ->
        do ptr <- {# get GstBuffer->data #} bufferPtr
           size <- {# get GstBuffer->size #} bufferPtr
#ifdef OLD_BYTESTRING
           BS.copyCStringLen (castPtr ptr, fromIntegral size)
#else
           BS.packCStringLen (castPtr ptr, fromIntegral size)
#endif

-- | Store an O(n) copy of the provided data in the current 'Buffer'.
bufferSetDataM :: (BufferClass bufferT, MonadIO m)
               => BS.ByteString            -- ^ @bs@ - the data to store in the current 'Buffer'
               -> MiniObjectT bufferT m ()
bufferSetDataM bs =
    marshalBufferM $ \bufferPtr ->
        BS.useAsCStringLen bs $ \(origData, size) ->
            do mallocData <- {# get GstBuffer->malloc_data #} bufferPtr
               when (mallocData /= nullPtr) $
                   {# call g_free #} $ castPtr mallocData
               newData <- liftM castPtr $ {# call g_malloc #} $ fromIntegral size
               copyBytes (castPtr newData) origData size
               {# set GstBuffer->data #} bufferPtr newData
               {# set GstBuffer->malloc_data #} bufferPtr newData
               {# set GstBuffer->size #} bufferPtr $ fromIntegral size
#endif

-- | Get a raw pointer to the internal data area for the current
--   buffer. The pointer may be used to write into the data area if
--   desired. This function is unsafe in that the pointer should not
--   be used once the 'Buffer' is returned.
unsafeBufferGetPtrM :: (BufferClass bufferT, MonadIO m)
                    => MiniObjectT bufferT m (Ptr Word8) -- ^ a pointer to the data stored in the current 'Buffer'
unsafeBufferGetPtrM = do
  ptr <- askMiniObjectPtr
  liftIO $ liftM castPtr $
      {# get GstBuffer->data #} ptr

marshalGetNum :: (BufferClass bufferT, Integral intT, Num numT, Eq numT)
              => (Ptr Buffer -> IO intT)
              -> numT
              -> bufferT
              -> Maybe numT
marshalGetNum getAction invalid buffer =
    let n = fromIntegral $ unsafePerformIO $
                withMiniObject (toBuffer buffer) getAction
    in if n /= invalid
          then Just n
          else Nothing

marshalGetNumM :: (BufferClass bufferT, Integral intT, Num numT, Eq numT, MonadIO m)
              => (Ptr Buffer -> IO intT)
              -> numT
              -> MiniObjectT bufferT m (Maybe numT)
marshalGetNumM getAction invalid =
    marshalBufferM $ \bufferPtr -> do
      n <- liftM fromIntegral $ getAction bufferPtr
      return $ if n /= invalid
                  then Just n
                  else Nothing

marshalSetNumM :: (BufferClass bufferT, Integral intT, Num numT, MonadIO m)
               => (Ptr Buffer -> numT -> IO ())
               -> intT
               -> Maybe intT
               -> MiniObjectT bufferT m ()
marshalSetNumM setAction invalid nM =
    let n = case nM of
              Just n' -> n'
              Nothing -> invalid
    in marshalBufferM $ flip setAction $ fromIntegral n

-- | Get the timestamp on @buffer@.
bufferGetTimestamp :: BufferClass bufferT
                   => bufferT         -- ^ @buffer@ - a 'Buffer'
                   -> Maybe ClockTime -- ^ the timestamp on @buffer@
bufferGetTimestamp =
    marshalGetNum {# get GstBuffer->timestamp #} clockTimeNone

-- | Get the timestamp on the current 'Buffer'.
bufferGetTimestampM :: (BufferClass bufferT, MonadIO m)
                    => MiniObjectT bufferT m (Maybe ClockTime) -- ^ the timestamp on the current 'Buffer'
bufferGetTimestampM =
    marshalGetNumM {# get GstBuffer->timestamp #} clockTimeNone

-- | Set the timestamp on the current 'Buffer'.
bufferSetTimestampM :: (BufferClass bufferT, MonadIO m)
                    => Maybe ClockTime          -- ^ @timestamp@ - the timestamp to set on the current 'Buffer'
                    -> MiniObjectT bufferT m ()
bufferSetTimestampM =
    marshalSetNumM {# set GstBuffer->timestamp #} clockTimeNone

-- | Get the duration of @buffer@.
bufferGetDuration :: BufferClass bufferT
                  => bufferT         -- ^ @buffer@ - a 'Buffer'
                  -> Maybe ClockTime -- ^ the duration of @buffer@
bufferGetDuration =
    marshalGetNum {# get GstBuffer->duration #} clockTimeNone

-- | Get the duration of the current 'Buffer'.
bufferGetDurationM :: (BufferClass bufferT, MonadIO m)
                   => MiniObjectT bufferT m (Maybe ClockTime) -- ^ the duration of the current 'Buffer'
bufferGetDurationM =
    marshalGetNumM {# get GstBuffer->duration #} clockTimeNone

-- | Set the duration of the current 'Buffer'.
bufferSetDurationM :: (BufferClass bufferT, MonadIO m)
                   => Maybe ClockTime          -- ^ @duration@ - the duration to set on the current 'Buffer'
                   -> MiniObjectT bufferT m ()
bufferSetDurationM =
    marshalSetNumM {# set GstBuffer->duration #} clockTimeNone

-- | Get the 'Caps' of @buffer@.
bufferGetCaps :: BufferClass bufferT
              => bufferT    -- ^ @buffer@ - a buffer
              -> Maybe Caps -- ^ the 'Caps' of @buffer@ if set, otherwise 'Nothing'
bufferGetCaps buffer =
    unsafePerformIO $
        {# call buffer_get_caps #} (toBuffer buffer) >>=
            maybePeek takeCaps

-- | Get the caps of the current 'Buffer'.
bufferGetCapsM :: (BufferClass bufferT, MonadIO m)
               => MiniObjectT bufferT m (Maybe Caps) -- ^ the 'Caps' of the current 'Buffer'
                                                     --   if set, otherwise 'Nothing'
bufferGetCapsM = do
  ptr <- askMiniObjectPtr
  liftIO $ gst_buffer_get_caps (castPtr ptr) >>=
               maybePeek takeCaps
  where _ = {# call buffer_get_caps #}

-- | Set the caps of the current 'Buffer'.
bufferSetCapsM :: (BufferClass bufferT, MonadIO m)
               => Maybe Caps               -- ^ @caps@ - the 'Caps' to set on the current
                                           --   'Buffer', or 'Nothing' to unset them
               -> MiniObjectT bufferT m ()
bufferSetCapsM capsM = do
  ptr <- askMiniObjectPtr
  liftIO $ withForeignPtr (case capsM of
                             Just caps -> unCaps caps
                             Nothing   -> nullForeignPtr)
                          (gst_buffer_set_caps $ castPtr ptr)
  where _ = {# call buffer_set_caps #}

-- | Get the start offset of the 'Buffer'.
bufferGetOffset :: BufferClass bufferT
                => bufferT      -- ^ @buffer@ - a buffer
                -> Maybe Word64 -- ^ the start offset of @buffer@ if set, otherwise 'Nothing'
bufferGetOffset =
    marshalGetNum {# get GstBuffer->offset #} bufferOffsetNone

-- | Get the start offset of the current 'Buffer'.
bufferGetOffsetM :: (BufferClass bufferT, MonadIO m)
                 => MiniObjectT bufferT m (Maybe Word64) -- ^ the start offset of the current
                                                         --   'Buffer' if set, otherwise 'Nothing'
bufferGetOffsetM =
    marshalGetNumM {# get GstBuffer->offset #} bufferOffsetNone

-- | Set the start offset of the current 'Buffer'.
bufferSetOffsetM :: (BufferClass bufferT, MonadIO m)
                 => Maybe Word64             -- ^ @offset@ - the start offset to set on the current buffer
                 -> MiniObjectT bufferT m ()
bufferSetOffsetM =
    marshalSetNumM {# set GstBuffer->offset #} bufferOffsetNone

-- | Get the end offset of the 'Buffer'.
bufferGetOffsetEnd :: BufferClass bufferT
                   => bufferT      -- ^ @buffer@ - a buffer
                   -> Maybe Word64 -- ^ the end offset of @buffer@ if set, otherwise 'Nothing'
bufferGetOffsetEnd =
    marshalGetNum {# get GstBuffer->offset_end #} bufferOffsetNone

-- | Get the end offset of the current 'Buffer'.
bufferGetOffsetEndM :: (BufferClass bufferT, MonadIO m)
                    => MiniObjectT bufferT m (Maybe Word64) -- ^ the start offset of the current
                                                            --   'Buffer' if set, otherwise 'Nothing'
bufferGetOffsetEndM =
    marshalGetNumM {# get GstBuffer->offset_end #} bufferOffsetNone

-- | Set the end offset of the current 'Buffer'.
bufferSetOffsetEndM :: (BufferClass bufferT, MonadIO m)
                    => Maybe Word64             -- ^ @offset@ - the end offset to set on the current buffer
                    -> MiniObjectT bufferT m ()
bufferSetOffsetEndM =
    marshalSetNumM {# set GstBuffer->offset_end #} bufferOffsetNone

-- | Return 'True' if the 'Buffer' marks a discontinuity in a stream, or
--   'False' otherwise. This typically occurs after a seek or a
--   dropped buffer from a live or network source.
bufferIsDiscont :: BufferClass bufferT
                => bufferT -- ^ @buffer@ - a buffer
                -> Bool    -- ^ 'True' if @buffer@ marks a discontinuity in a stream
bufferIsDiscont =
    (elem BufferDiscont) . bufferGetFlags

-- | Return 'True' if the current 'Buffer' marks a discontinuity in a
--   stream, or 'False' otherwise.
bufferIsDiscontM :: (BufferClass bufferT, MonadIO m)
                 => MiniObjectT bufferT m Bool -- ^ 'True' if the current buffer marks a
                                               --   discontinuity in a stream
bufferIsDiscontM =
    liftM (elem BufferDiscont) $ bufferGetFlagsM

-- | Create an empty 'Buffer' and mutate it according to the given
--   action. Once this function returns, the 'Buffer' is immutable.
bufferCreateEmpty :: MonadIO m
                  => MiniObjectT Buffer m a -- ^ @mutate@ - the mutating action
                  -> m (Buffer, a)          -- ^ the new buffer and the action's result
bufferCreateEmpty =
    marshalMiniObjectModify $ liftIO {# call buffer_new #}

-- | Create and mutate a 'Buffer' of the given size.
bufferCreate :: MonadIO m
             => Word                   -- ^ @size@ - the size of the 'Buffer' to be created
             -> MiniObjectT Buffer m a -- ^ @mutate@ - the mutating action
             -> m (Buffer, a)          -- ^ the new 'Buffer' and the action's result
bufferCreate size =
    marshalMiniObjectModify $
        liftIO $ {# call buffer_new_and_alloc #} $ fromIntegral size

-- | Create a sub-buffer from an existing 'Buffer' with the given offset
--   and size. This sub-buffer uses the actual memory space of the
--   parent buffer. Thus function will copy the offset and timestamp
--   fields when the offset is 0. Otherwise, they will both be set to
--   'Nothing'. If the offset is 0 and the size is the total size of
--   the parent, the duration and offset end fields are also
--   copied. Otherwise they will be set to 'Nothing'.
bufferCreateSub :: BufferClass bufferT
                => bufferT      -- ^ @parent@ - the parent buffer
                -> Word         -- ^ @offset@ - the offset
                -> Word         -- ^ @size@ - the size
                -> Maybe Buffer -- ^ the new sub-buffer
bufferCreateSub parent offset size =
    unsafePerformIO $
        {# call buffer_create_sub #} (toBuffer parent)
                                     (fromIntegral offset)
                                     (fromIntegral size) >>=
            maybePeek takeMiniObject

-- | Return 'True' if 'bufferSpan' can be done without copying the
--   data, or 'False' otherwise.
bufferIsSpanFast :: (BufferClass bufferT1, BufferClass bufferT2)
                 => bufferT1 -- ^ @buffer1@ - the first buffer
                 -> bufferT2 -- ^ @buffer2@ - the second buffer
                 -> Bool     -- ^ 'True' if the buffers are contiguous,
                             --   or 'False' if copying would be
                             --   required
bufferIsSpanFast buffer1 buffer2 =
    toBool $ unsafePerformIO $
        {# call buffer_is_span_fast #} (toBuffer buffer1)
                                       (toBuffer buffer2)

-- | Create a new 'Buffer' that consists of a span across the given
--   buffers. Logically, the buffers are concatenated to make a larger
--   buffer, and a new buffer is created at the given offset and with
--   the given size.
--
--   If the two buffers are children of the same larger buffer, and
--   are contiguous, no copying is necessary. You can use
--   'bufferIsSpanFast' to determine if copying is needed.
bufferSpan :: (BufferClass bufferT1, BufferClass bufferT2)
           => bufferT1     -- ^ @buffer1@ - the first buffer
           -> Word32       -- ^ @offset@ - the offset into the concatenated buffer
           -> bufferT2     -- ^ @buffer2@ - the second buffer
           -> Word32       -- ^ @len@ - the length of the final buffer
           -> Maybe Buffer -- ^ the spanning buffer, or 'Nothing' if
                           --   the arguments are invalid
bufferSpan buffer1 offset buffer2 len =
    unsafePerformIO $
        {# call buffer_span #} (toBuffer buffer1)
                               (fromIntegral offset)
                               (toBuffer buffer2)
                               (fromIntegral len) >>=
            maybePeek takeMiniObject

-- | Concatenate two buffers. If the buffers point to contiguous memory
--   areas, no copying will occur.
bufferMerge :: (BufferClass bufferT1, BufferClass bufferT2)
            => bufferT1 -- ^ @buffer1@ - a buffer
            -> bufferT2 -- ^ @buffer2@ - a buffer
            -> Buffer   -- ^ the concatenation of the buffers
bufferMerge buffer1 buffer2 =
    unsafePerformIO $
        {# call buffer_merge #} (toBuffer buffer1)
                                (toBuffer buffer2) >>=
            takeMiniObject

{-# 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)
--
--  Data-passing buffer type, supporting sub-buffers.
module Media.Streaming.GStreamer.Core.Buffer (

-- * Types

  -- | 'Buffer's are the basic unit of data transfer in GStreamer. The
  --   'Buffer' type provides all the state necessary to define a
  --   region of memory as part of a stream. Sub-buffers are also
  --   supported, allowing a smaller region of a 'Buffer' to become its
  --   own 'Buffer', with mechansims in place to ensure that neither
  --   memory space goes away prematurely.
  Buffer,
  BufferClass,
  castToBuffer,
  gTypeBuffer,

  BufferFlags(..),

-- * Buffer Operations
  bufferOffsetNone,
  bufferGetFlags,
  bufferGetFlagsM,
  bufferSetFlagsM,
  bufferUnsetFlagsM,
  bufferGetSize,
  bufferGetSizeM,
#if __GLASGOW_HASKELL__ >= 606
  bufferGetData,
  bufferGetDataM,
  bufferSetDataM,
#endif
  unsafeBufferGetPtrM,
  bufferGetTimestamp,
  bufferGetTimestampM,
  bufferSetTimestampM,
  bufferGetDuration,
  bufferGetDurationM,
  bufferSetDurationM,
  bufferGetCaps,
  bufferGetCapsM,
  bufferSetCapsM,
  bufferGetOffset,
  bufferGetOffsetM,
  bufferSetOffsetM,
  bufferGetOffsetEnd,
  bufferGetOffsetEndM,
  bufferSetOffsetEndM,
  bufferIsDiscont,
  bufferIsDiscontM,

  bufferCreateEmpty,
  bufferCreate,
  bufferCreateSub,

  bufferIsSpanFast,
  bufferSpan,
  bufferMerge

  ) where

import Control.Monad ( liftM
                     , when )
import Control.Monad.Trans
#if __GLASGOW_HASKELL__ >= 606
import qualified Data.ByteString as BS
#if __GLASGOW_HASKELL__ < 608
#define OLD_BYTESTRING
#endif
#endif

{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.FFI

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

-- | Get the flags set on @buffer@.
bufferGetFlags :: BufferClass bufferT
               => bufferT       -- ^ @buffer@ - a 'Buffer'
               -> [BufferFlags] -- ^ the flags set on @buffer@
bufferGetFlags = mkMiniObjectGetFlags

-- | Get the flags set on the current 'Buffer'.
bufferGetFlagsM :: (BufferClass bufferT, MonadIO m)
                => MiniObjectT bufferT m [BufferFlags] -- ^ the flags set on the current 'Buffer'
bufferGetFlagsM = mkMiniObjectGetFlagsM

-- | Set flags on the current 'Buffer'.
bufferSetFlagsM :: (BufferClass bufferT, MonadIO m)
                => [BufferFlags]            -- ^ @flags@ - the flags to set on the current 'Buffer'
                -> MiniObjectT bufferT m ()
bufferSetFlagsM = mkMiniObjectSetFlagsM

-- | Unset flags on the current 'Buffer'.
bufferUnsetFlagsM :: (BufferClass bufferT, MonadIO m)
                  => [BufferFlags]                    -- ^ @flags@ - the flags to unset on the current 'Buffer'
                  -> MiniObjectT bufferT m ()
bufferUnsetFlagsM = mkMiniObjectUnsetFlagsM

-- | Get @buffer@'s size in bytes.
bufferGetSize :: BufferClass bufferT
              => bufferT -- ^ @buffer@ - a 'Buffer'
              -> Word    -- ^ the size of @buffer@ in bytes
bufferGetSize buffer =
    fromIntegral $ unsafePerformIO $
        withMiniObject buffer {# get GstBuffer->size #}

marshalBufferM :: (BufferClass bufferT, MonadIO m)
               => (Ptr Buffer -> IO a)
               -> MiniObjectT bufferT m a
marshalBufferM action = do
  ptr <- askMiniObjectPtr
  liftIO $ action $ castPtr ptr

-- | Get the size of the current 'Buffer' in bytes.
bufferGetSizeM :: (BufferClass bufferT, MonadIO m)
               => MiniObjectT bufferT m Word -- ^ the size of the current 'Buffer' in bytes
bufferGetSizeM =
    liftM fromIntegral $
        marshalBufferM {# get GstBuffer->size #}

#if __GLASGOW_HASKELL__ >= 606
-- | Make an O(n) copy of the data stored in @buffer@.
bufferGetData :: BufferClass bufferT
              => bufferT       -- ^ @buffer@ - a 'Buffer'
              -> BS.ByteString -- ^ the data stored in @buffer@
bufferGetData buffer =
    unsafePerformIO $ withMiniObject buffer $ \bufferPtr ->
        do ptr <- {# get GstBuffer->data #} bufferPtr
           size <- {# get GstBuffer->size #} bufferPtr
#ifdef OLD_BYTESTRING
           BS.copyCStringLen (castPtr ptr, fromIntegral size)
#else
           BS.packCStringLen (castPtr ptr, fromIntegral size)
#endif

-- | Make an O(n) copy of the current 'Buffer'.
bufferGetDataM :: (BufferClass bufferT, MonadIO m)
               => MiniObjectT bufferT m BS.ByteString -- ^ the data stored in the current 'Buffer'
bufferGetDataM =
    marshalBufferM $ \bufferPtr ->
        do ptr <- {# get GstBuffer->data #} bufferPtr
           size <- {# get GstBuffer->size #} bufferPtr
#ifdef OLD_BYTESTRING
           BS.copyCStringLen (castPtr ptr, fromIntegral size)
#else
           BS.packCStringLen (castPtr ptr, fromIntegral size)
#endif

-- | Store an O(n) copy of the provided data in the current 'Buffer'.
bufferSetDataM :: (BufferClass bufferT, MonadIO m)
               => BS.ByteString            -- ^ @bs@ - the data to store in the current 'Buffer'
               -> MiniObjectT bufferT m ()
bufferSetDataM bs =
    marshalBufferM $ \bufferPtr ->
        BS.useAsCStringLen bs $ \(origData, size) ->
            do mallocData <- {# get GstBuffer->malloc_data #} bufferPtr
               when (mallocData /= nullPtr) $
                   {# call g_free #} $ castPtr mallocData
               newData <- liftM castPtr $ {# call g_malloc #} $ fromIntegral size
               copyBytes (castPtr newData) origData size
               {# set GstBuffer->data #} bufferPtr newData
               {# set GstBuffer->malloc_data #} bufferPtr newData
               {# set GstBuffer->size #} bufferPtr $ fromIntegral size
#endif

-- | Get a raw pointer to the internal data area for the current
--   buffer. The pointer may be used to write into the data area if
--   desired. This function is unsafe in that the pointer should not
--   be used once the 'Buffer' is returned.
unsafeBufferGetPtrM :: (BufferClass bufferT, MonadIO m)
                    => MiniObjectT bufferT m (Ptr Word8) -- ^ a pointer to the data stored in the current 'Buffer'
unsafeBufferGetPtrM = do
  ptr <- askMiniObjectPtr
  liftIO $ liftM castPtr $
      {# get GstBuffer->data #} ptr

marshalGetNum :: (BufferClass bufferT, Integral intT, Num numT)
              => (Ptr Buffer -> IO intT)
              -> numT
              -> bufferT
              -> Maybe numT
marshalGetNum getAction invalid buffer =
    let n = fromIntegral $ unsafePerformIO $
                withMiniObject (toBuffer buffer) getAction
    in if n /= invalid
          then Just n
          else Nothing

marshalGetNumM :: (BufferClass bufferT, Integral intT, Num numT, MonadIO m)
              => (Ptr Buffer -> IO intT)
              -> numT
              -> MiniObjectT bufferT m (Maybe numT)
marshalGetNumM getAction invalid =
    marshalBufferM $ \bufferPtr -> do
      n <- liftM fromIntegral $ getAction bufferPtr
      return $ if n /= invalid
                  then Just n
                  else Nothing

marshalSetNumM :: (BufferClass bufferT, Integral intT, Num numT, MonadIO m)
               => (Ptr Buffer -> numT -> IO ())
               -> intT
               -> Maybe intT
               -> MiniObjectT bufferT m ()
marshalSetNumM setAction invalid nM =
    let n = case nM of
              Just n' -> n'
              Nothing -> invalid
    in marshalBufferM $ flip setAction $ fromIntegral n

-- | Get the timestamp on @buffer@.
bufferGetTimestamp :: BufferClass bufferT
                   => bufferT         -- ^ @buffer@ - a 'Buffer'
                   -> Maybe ClockTime -- ^ the timestamp on @buffer@
bufferGetTimestamp =
    marshalGetNum {# get GstBuffer->timestamp #} clockTimeNone

-- | Get the timestamp on the current 'Buffer'.
bufferGetTimestampM :: (BufferClass bufferT, MonadIO m)
                    => MiniObjectT bufferT m (Maybe ClockTime) -- ^ the timestamp on the current 'Buffer'
bufferGetTimestampM =
    marshalGetNumM {# get GstBuffer->timestamp #} clockTimeNone

-- | Set the timestamp on the current 'Buffer'.
bufferSetTimestampM :: (BufferClass bufferT, MonadIO m)
                    => Maybe ClockTime          -- ^ @timestamp@ - the timestamp to set on the current 'Buffer'
                    -> MiniObjectT bufferT m ()
bufferSetTimestampM =
    marshalSetNumM {# set GstBuffer->timestamp #} clockTimeNone

-- | Get the duration of @buffer@.
bufferGetDuration :: BufferClass bufferT
                  => bufferT         -- ^ @buffer@ - a 'Buffer'
                  -> Maybe ClockTime -- ^ the duration of @buffer@
bufferGetDuration =
    marshalGetNum {# get GstBuffer->duration #} clockTimeNone

-- | Get the duration of the current 'Buffer'.
bufferGetDurationM :: (BufferClass bufferT, MonadIO m)
                   => MiniObjectT bufferT m (Maybe ClockTime) -- ^ the duration of the current 'Buffer'
bufferGetDurationM =
    marshalGetNumM {# get GstBuffer->duration #} clockTimeNone

-- | Set the duration of the current 'Buffer'.
bufferSetDurationM :: (BufferClass bufferT, MonadIO m)
                   => Maybe ClockTime          -- ^ @duration@ - the duration to set on the current 'Buffer'
                   -> MiniObjectT bufferT m ()
bufferSetDurationM =
    marshalSetNumM {# set GstBuffer->duration #} clockTimeNone

-- | Get the 'Caps' of @buffer@.
bufferGetCaps :: BufferClass bufferT
              => bufferT    -- ^ @buffer@ - a buffer
              -> Maybe Caps -- ^ the 'Caps' of @buffer@ if set, otherwise 'Nothing'
bufferGetCaps buffer =
    unsafePerformIO $
        {# call buffer_get_caps #} (toBuffer buffer) >>=
            maybePeek takeCaps

-- | Get the caps of the current 'Buffer'.
bufferGetCapsM :: (BufferClass bufferT, MonadIO m)
               => MiniObjectT bufferT m (Maybe Caps) -- ^ the 'Caps' of the current 'Buffer'
                                                     --   if set, otherwise 'Nothing'
bufferGetCapsM = do
  ptr <- askMiniObjectPtr
  liftIO $ gst_buffer_get_caps (castPtr ptr) >>=
               maybePeek takeCaps
  where _ = {# call buffer_get_caps #}

-- | Set the caps of the current 'Buffer'.
bufferSetCapsM :: (BufferClass bufferT, MonadIO m)
               => Maybe Caps               -- ^ @caps@ - the 'Caps' to set on the current
                                           --   'Buffer', or 'Nothing' to unset them
               -> MiniObjectT bufferT m ()
bufferSetCapsM capsM = do
  ptr <- askMiniObjectPtr
  liftIO $ withForeignPtr (case capsM of
                             Just caps -> unCaps caps
                             Nothing   -> nullForeignPtr)
                          (gst_buffer_set_caps $ castPtr ptr)
  where _ = {# call buffer_set_caps #}

-- | Get the start offset of the 'Buffer'.
bufferGetOffset :: BufferClass bufferT
                => bufferT      -- ^ @buffer@ - a buffer
                -> Maybe Word64 -- ^ the start offset of @buffer@ if set, otherwise 'Nothing'
bufferGetOffset =
    marshalGetNum {# get GstBuffer->offset #} bufferOffsetNone

-- | Get the start offset of the current 'Buffer'.
bufferGetOffsetM :: (BufferClass bufferT, MonadIO m)
                 => MiniObjectT bufferT m (Maybe Word64) -- ^ the start offset of the current
                                                         --   'Buffer' if set, otherwise 'Nothing'
bufferGetOffsetM =
    marshalGetNumM {# get GstBuffer->offset #} bufferOffsetNone

-- | Set the start offset of the current 'Buffer'.
bufferSetOffsetM :: (BufferClass bufferT, MonadIO m)
                 => Maybe Word64             -- ^ @offset@ - the start offset to set on the current buffer
                 -> MiniObjectT bufferT m ()
bufferSetOffsetM =
    marshalSetNumM {# set GstBuffer->offset #} bufferOffsetNone

-- | Get the end offset of the 'Buffer'.
bufferGetOffsetEnd :: BufferClass bufferT
                   => bufferT      -- ^ @buffer@ - a buffer
                   -> Maybe Word64 -- ^ the end offset of @buffer@ if set, otherwise 'Nothing'
bufferGetOffsetEnd =
    marshalGetNum {# get GstBuffer->offset_end #} bufferOffsetNone

-- | Get the end offset of the current 'Buffer'.
bufferGetOffsetEndM :: (BufferClass bufferT, MonadIO m)
                    => MiniObjectT bufferT m (Maybe Word64) -- ^ the start offset of the current
                                                            --   'Buffer' if set, otherwise 'Nothing'
bufferGetOffsetEndM =
    marshalGetNumM {# get GstBuffer->offset_end #} bufferOffsetNone

-- | Set the end offset of the current 'Buffer'.
bufferSetOffsetEndM :: (BufferClass bufferT, MonadIO m)
                    => Maybe Word64             -- ^ @offset@ - the end offset to set on the current buffer
                    -> MiniObjectT bufferT m ()
bufferSetOffsetEndM =
    marshalSetNumM {# set GstBuffer->offset_end #} bufferOffsetNone

-- | Return 'True' if the 'Buffer' marks a discontinuity in a stream, or
--   'False' otherwise. This typically occurs after a seek or a
--   dropped buffer from a live or network source.
bufferIsDiscont :: BufferClass bufferT
                => bufferT -- ^ @buffer@ - a buffer
                -> Bool    -- ^ 'True' if @buffer@ marks a discontinuity in a stream
bufferIsDiscont =
    (elem BufferDiscont) . bufferGetFlags

-- | Return 'True' if the current 'Buffer' marks a discontinuity in a
--   stream, or 'False' otherwise.
bufferIsDiscontM :: (BufferClass bufferT, MonadIO m)
                 => MiniObjectT bufferT m Bool -- ^ 'True' if the current buffer marks a
                                               --   discontinuity in a stream
bufferIsDiscontM =
    liftM (elem BufferDiscont) $ bufferGetFlagsM

-- | Create an empty 'Buffer' and mutate it according to the given
--   action. Once this function returns, the 'Buffer' is immutable.
bufferCreateEmpty :: MonadIO m
                  => MiniObjectT Buffer m a -- ^ @mutate@ - the mutating action
                  -> m (Buffer, a)          -- ^ the new buffer and the action's result
bufferCreateEmpty =
    marshalMiniObjectModify $ liftIO {# call buffer_new #}

-- | Create and mutate a 'Buffer' of the given size.
bufferCreate :: MonadIO m
             => Word                   -- ^ @size@ - the size of the 'Buffer' to be created
             -> MiniObjectT Buffer m a -- ^ @mutate@ - the mutating action
             -> m (Buffer, a)          -- ^ the new 'Buffer' and the action's result
bufferCreate size =
    marshalMiniObjectModify $
        liftIO $ {# call buffer_new_and_alloc #} $ fromIntegral size

-- | Create a sub-buffer from an existing 'Buffer' with the given offset
--   and size. This sub-buffer uses the actual memory space of the
--   parent buffer. Thus function will copy the offset and timestamp
--   fields when the offset is 0. Otherwise, they will both be set to
--   'Nothing'. If the offset is 0 and the size is the total size of
--   the parent, the duration and offset end fields are also
--   copied. Otherwise they will be set to 'Nothing'.
bufferCreateSub :: BufferClass bufferT
                => bufferT      -- ^ @parent@ - the parent buffer
                -> Word         -- ^ @offset@ - the offset
                -> Word         -- ^ @size@ - the size
                -> Maybe Buffer -- ^ the new sub-buffer
bufferCreateSub parent offset size =
    unsafePerformIO $
        {# call buffer_create_sub #} (toBuffer parent)
                                     (fromIntegral offset)
                                     (fromIntegral size) >>=
            maybePeek takeMiniObject

-- | Return 'True' if 'bufferSpan' can be done without copying the
--   data, or 'False' otherwise.
bufferIsSpanFast :: (BufferClass bufferT1, BufferClass bufferT2)
                 => bufferT1 -- ^ @buffer1@ - the first buffer
                 -> bufferT2 -- ^ @buffer2@ - the second buffer
                 -> Bool     -- ^ 'True' if the buffers are contiguous,
                             --   or 'False' if copying would be
                             --   required
bufferIsSpanFast buffer1 buffer2 =
    toBool $ unsafePerformIO $
        {# call buffer_is_span_fast #} (toBuffer buffer1)
                                       (toBuffer buffer2)

-- | Create a new 'Buffer' that consists of a span across the given
--   buffers. Logically, the buffers are concatenated to make a larger
--   buffer, and a new buffer is created at the given offset and with
--   the given size.
--
--   If the two buffers are children of the same larger buffer, and
--   are contiguous, no copying is necessary. You can use
--   'bufferIsSpanFast' to determine if copying is needed.
bufferSpan :: (BufferClass bufferT1, BufferClass bufferT2)
           => bufferT1     -- ^ @buffer1@ - the first buffer
           -> Word32       -- ^ @offset@ - the offset into the concatenated buffer
           -> bufferT2     -- ^ @buffer2@ - the second buffer
           -> Word32       -- ^ @len@ - the length of the final buffer
           -> Maybe Buffer -- ^ the spanning buffer, or 'Nothing' if
                           --   the arguments are invalid
bufferSpan buffer1 offset buffer2 len =
    unsafePerformIO $
        {# call buffer_span #} (toBuffer buffer1)
                               (fromIntegral offset)
                               (toBuffer buffer2)
                               (fromIntegral len) >>=
            maybePeek takeMiniObject

-- | Concatenate two buffers. If the buffers point to contiguous memory
--   areas, no copying will occur.
bufferMerge :: (BufferClass bufferT1, BufferClass bufferT2)
            => bufferT1 -- ^ @buffer1@ - a buffer
            -> bufferT2 -- ^ @buffer2@ - a buffer
            -> Buffer   -- ^ the concatenation of the buffers
bufferMerge buffer1 buffer2 =
    unsafePerformIO $
        {# call buffer_merge #} (toBuffer buffer1)
                                (toBuffer buffer2) >>=
            takeMiniObject