Make constructor safe since it may trigger a signal on the given Adjustment.

-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget SpinButton
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.10 $ from $Date: 2005/10/19 12:57:37 $
--
--  Copyright (C) 1999-2005 Axel Simon
--
--  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)
--
-- Retrieve an integer or floating-point number from the user
--
module Graphics.UI.Gtk.Entry.SpinButton (
-- * Detail
--
-- | A 'SpinButton' is an ideal way to allow the user to set the value of some
-- attribute. Rather than having to directly type a number into a 'Entry',
-- 'SpinButton' allows the user to click on one of two arrows to increment or
-- decrement the displayed value. A value can still be typed in, with the bonus
-- that it can be checked to ensure it is in a given range.
--
-- The main properties of a 'SpinButton' are through a 'Adjustment'. See the
-- 'Adjustment' section for more details about an adjustment's properties.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Entry'
-- |                     +----SpinButton
-- @

-- * Types
  SpinButton,
  SpinButtonClass,
  castToSpinButton,
  toSpinButton,

-- * Constructors
  spinButtonNew,
  spinButtonNewWithRange,

-- * Methods
  spinButtonConfigure,
  spinButtonSetAdjustment,
  spinButtonGetAdjustment,
  spinButtonSetDigits,
  spinButtonGetDigits,
  spinButtonSetIncrements,
  spinButtonGetIncrements,
  spinButtonSetRange,
  spinButtonGetRange,
  spinButtonGetValue,
  spinButtonGetValueAsInt,
  spinButtonSetValue,
  SpinButtonUpdatePolicy(..),
  spinButtonSetUpdatePolicy,
  spinButtonGetUpdatePolicy,
  spinButtonSetNumeric,
  spinButtonGetNumeric,
  SpinType(..),
  spinButtonSpin,
  spinButtonSetWrap,
  spinButtonGetWrap,
  spinButtonSetSnapToTicks,
  spinButtonGetSnapToTicks,
  spinButtonUpdate,

-- * Attributes
  spinButtonAdjustment,
  spinButtonClimbRate,
  spinButtonDigits,
  spinButtonSnapToTicks,
  spinButtonNumeric,
  spinButtonWrap,
  spinButtonUpdatePolicy,
  spinButtonValue,

-- * Signals
  onInput,
  afterInput,
  onOutput,
  afterOutput,
  onValueSpinned,
  afterValueSpinned
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(inputError)
import Graphics.UI.Gtk.General.Enums	(SpinButtonUpdatePolicy(..), SpinType(..))

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

--------------------
-- Interfaces

instance EditableClass SpinButton

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

-- | Creates a new 'SpinButton'.
--
spinButtonNew ::
    Adjustment    -- ^ @adjustment@ - the 'Adjustment' object that this spin
                  -- button should use.
 -> Double        -- ^ @climbRate@ - specifies how much the spin button
                  -- changes when an arrow is clicked on.
 -> Int           -- ^ @digits@ - the number of decimal places to display.
 -> IO SpinButton
spinButtonNew adjustment climbRate digits =
  makeNewObject mkSpinButton $
  liftM (castPtr :: Ptr Widget -> Ptr SpinButton) $
  {# call spin_button_new #}
    adjustment
    (realToFrac climbRate)
    (fromIntegral digits)

-- | This is a convenience constructor that allows creation of a numeric
-- 'SpinButton' without manually creating an adjustment. The value is initially
-- set to the minimum value and a page increment of 10 * @step@ is the default.
-- The precision of the spin button is equivalent to the precision of @step@.
--
-- Note that the way in which the precision is derived works best if @step@
-- is a power of ten. If the resulting precision is not suitable for your
-- needs, use 'spinButtonSetDigits' to correct it.
--
spinButtonNewWithRange ::
    Double        -- ^ @min@ - Minimum allowable value
 -> Double        -- ^ @max@ - Maximum allowable value
 -> Double        -- ^ @step@ - Increment added or subtracted by spinning the
                  -- widget
 -> IO SpinButton
spinButtonNewWithRange min max step =
  makeNewObject mkSpinButton $
  liftM (castPtr :: Ptr Widget -> Ptr SpinButton) $
  {# call unsafe spin_button_new_with_range #}
    (realToFrac min)
    (realToFrac max)
    (realToFrac step)

--------------------
-- Methods

-- | Changes the properties of an existing spin button. The adjustment, climb
-- rate, and number of decimal places are all changed accordingly, after this
-- function call.
--
spinButtonConfigure :: SpinButtonClass self => self
 -> Adjustment -- ^ @adjustment@ - a 'Adjustment'.
 -> Double     -- ^ @climbRate@ - the new climb rate.
 -> Int        -- ^ @digits@ - the number of decimal places to display in the
               -- spin button.
 -> IO ()
spinButtonConfigure self adjustment climbRate digits =
  {# call spin_button_configure #}
    (toSpinButton self)
    adjustment
    (realToFrac climbRate)
    (fromIntegral digits)

-- | Replaces the 'Adjustment' associated with the spin button.
--
spinButtonSetAdjustment :: SpinButtonClass self => self
 -> Adjustment -- ^ @adjustment@ - a 'Adjustment' to replace the existing
               -- adjustment
 -> IO ()
spinButtonSetAdjustment self adjustment =
  {# call spin_button_set_adjustment #}
    (toSpinButton self)
    adjustment

-- | Get the adjustment associated with a 'SpinButton'
--
spinButtonGetAdjustment :: SpinButtonClass self => self
 -> IO Adjustment -- ^ returns the 'Adjustment' of @spinButton@
spinButtonGetAdjustment self =
  makeNewObject mkAdjustment $
  {# call unsafe spin_button_get_adjustment #}
    (toSpinButton self)

-- | Set the precision to be displayed by @spinButton@. Up to 20 digit
-- precision is allowed.
--
spinButtonSetDigits :: SpinButtonClass self => self
 -> Int   -- ^ @digits@ - the number of digits after the decimal point to be
          -- displayed for the spin button's value
 -> IO ()
spinButtonSetDigits self digits =
  {# call spin_button_set_digits #}
    (toSpinButton self)
    (fromIntegral digits)

-- | Fetches the precision of @spinButton@. See 'spinButtonSetDigits'.
--
spinButtonGetDigits :: SpinButtonClass self => self
 -> IO Int -- ^ returns the current precision
spinButtonGetDigits self =
  liftM fromIntegral $
  {# call spin_button_get_digits #}
    (toSpinButton self)

-- | Sets the step and page increments for the spin button. This affects how
-- quickly the value changes when the spin button's arrows are activated.
--
spinButtonSetIncrements :: SpinButtonClass self => self
 -> Double -- ^ @step@ - increment applied for a button 1 press.
 -> Double -- ^ @page@ - increment applied for a button 2 press.
 -> IO ()
spinButtonSetIncrements self step page =
  {# call spin_button_set_increments #}
    (toSpinButton self)
    (realToFrac step)
    (realToFrac page)

-- | Gets the current step and page the increments used by the spin button. See
-- 'spinButtonSetIncrements'.
--
spinButtonGetIncrements :: SpinButtonClass self => self
 -> IO (Double, Double) -- ^ @(step, page)@ - step increment and page increment
spinButtonGetIncrements self =
  alloca $ \stepPtr ->
  alloca $ \pagePtr -> do
  {# call unsafe spin_button_get_increments #}
    (toSpinButton self)
    stepPtr
    pagePtr
  step <- peek stepPtr
  page <- peek pagePtr
  return (realToFrac step, realToFrac page)

-- | Sets the minimum and maximum allowable values for the spin button
--
spinButtonSetRange :: SpinButtonClass self => self
 -> Double -- ^ @min@ - minimum allowable value
 -> Double -- ^ @max@ - maximum allowable value
 -> IO ()
spinButtonSetRange self min max =
  {# call spin_button_set_range #}
    (toSpinButton self)
    (realToFrac min)
    (realToFrac max)

-- | Gets the range allowed for the spin button. See 'spinButtonSetRange'.
--
spinButtonGetRange :: SpinButtonClass self => self
 -> IO (Double, Double) -- ^ @(min, max)@ - minimum and maximum allowed value
spinButtonGetRange self =
  alloca $ \minPtr ->
  alloca $ \maxPtr -> do
  {# call unsafe spin_button_get_range #}
    (toSpinButton self)
    minPtr
    maxPtr
  min <- peek minPtr
  max <- peek maxPtr
  return (realToFrac min, realToFrac max)

-- | Get the value of the spin button as a floating point value.
--
spinButtonGetValue :: SpinButtonClass self => self -> IO Double
spinButtonGetValue self =
  liftM realToFrac $
  {# call unsafe spin_button_get_value #}
    (toSpinButton self)

-- | Get the value of the spin button as an integral value.
--
spinButtonGetValueAsInt :: SpinButtonClass self => self -> IO Int
spinButtonGetValueAsInt self =
  liftM fromIntegral $
  {# call unsafe spin_button_get_value_as_int #}
    (toSpinButton self)

-- | Set the value of the spin button.
--
spinButtonSetValue :: SpinButtonClass self => self -> Double -> IO ()
spinButtonSetValue self value =
  {# call spin_button_set_value #}
    (toSpinButton self)
    (realToFrac value)

-- | Sets the update behavior of a spin button. This determines whether the
-- spin button is always updated or only when a valid value is set.
--
spinButtonSetUpdatePolicy :: SpinButtonClass self => self
 -> SpinButtonUpdatePolicy -- ^ @policy@ - a 'SpinButtonUpdatePolicy' value
 -> IO ()
spinButtonSetUpdatePolicy self policy =
  {# call spin_button_set_update_policy #}
    (toSpinButton self)
    ((fromIntegral . fromEnum) policy)

-- | Gets the update behavior of a spin button. See
-- 'spinButtonSetUpdatePolicy'.
--
spinButtonGetUpdatePolicy :: SpinButtonClass self => self
 -> IO SpinButtonUpdatePolicy -- ^ returns the current update policy
spinButtonGetUpdatePolicy self =
  liftM (toEnum . fromIntegral) $
  {# call unsafe spin_button_get_update_policy #}
    (toSpinButton self)

-- | Sets the flag that determines if non-numeric text can be typed into the
-- spin button.
--
spinButtonSetNumeric :: SpinButtonClass self => self
 -> Bool  -- ^ @numeric@ - flag indicating if only numeric entry is allowed.
 -> IO ()
spinButtonSetNumeric self numeric =
  {# call spin_button_set_numeric #}
    (toSpinButton self)
    (fromBool numeric)

-- | Returns whether non-numeric text can be typed into the spin button. See
-- 'spinButtonSetNumeric'.
--
spinButtonGetNumeric :: SpinButtonClass self => self
 -> IO Bool -- ^ returns @True@ if only numeric text can be entered
spinButtonGetNumeric self =
  liftM toBool $
  {# call unsafe spin_button_get_numeric #}
    (toSpinButton self)

-- | Increment or decrement a spin button's value in a specified direction by
-- a specified amount.
--
spinButtonSpin :: SpinButtonClass self => self
 -> SpinType -- ^ @direction@ - a 'SpinType' indicating the direction to spin.
 -> Double   -- ^ @increment@ - step increment to apply in the specified
             -- direction.
 -> IO ()
spinButtonSpin self direction increment =
  {# call spin_button_spin #}
    (toSpinButton self)
    ((fromIntegral . fromEnum) direction)
    (realToFrac increment)

-- | Sets the flag that determines if a spin button value wraps around to the
-- opposite limit when the upper or lower limit of the range is exceeded.
--
spinButtonSetWrap :: SpinButtonClass self => self
 -> Bool  -- ^ @wrap@ - a flag indicating if wrapping behavior is performed.
 -> IO ()
spinButtonSetWrap self wrap =
  {# call spin_button_set_wrap #}
    (toSpinButton self)
    (fromBool wrap)

-- | Returns whether the spin button's value wraps around to the opposite
-- limit when the upper or lower limit of the range is exceeded. See
-- 'spinButtonSetWrap'.
--
spinButtonGetWrap :: SpinButtonClass self => self
 -> IO Bool -- ^ returns @True@ if the spin button wraps around
spinButtonGetWrap self =
  liftM toBool $
  {# call spin_button_get_wrap #}
    (toSpinButton self)

-- | Sets the policy as to whether values are corrected to the nearest step
-- increment when a spin button is activated after providing an invalid value.
--
spinButtonSetSnapToTicks :: SpinButtonClass self => self
 -> Bool  -- ^ @snapToTicks@ - a flag indicating if invalid values should be
          -- corrected.
 -> IO ()
spinButtonSetSnapToTicks self snapToTicks =
  {# call spin_button_set_snap_to_ticks #}
    (toSpinButton self)
    (fromBool snapToTicks)

-- | Returns whether the values are corrected to the nearest step. See
-- 'spinButtonSetSnapToTicks'.
--
spinButtonGetSnapToTicks :: SpinButtonClass self => self
 -> IO Bool -- ^ returns @True@ if values are snapped to the nearest step.
spinButtonGetSnapToTicks self =
  liftM toBool $
  {# call unsafe spin_button_get_snap_to_ticks #}
    (toSpinButton self)

-- | Manually force an update of the spin button.
--
spinButtonUpdate :: SpinButtonClass self => self -> IO ()
spinButtonUpdate self =
  {# call spin_button_update #}
    (toSpinButton self)

--------------------
-- Attributes

-- | The adjustment that holds the value of the spinbutton.
--
spinButtonAdjustment :: SpinButtonClass self => Attr self Adjustment
spinButtonAdjustment = newAttr
  spinButtonGetAdjustment
  spinButtonSetAdjustment

-- | The acceleration rate when you hold down a button.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
spinButtonClimbRate :: SpinButtonClass self => Attr self Double
spinButtonClimbRate = newAttrFromDoubleProperty "climb-rate"

-- | The number of decimal places to display.
--
-- Allowed values: \<= 20
--
-- Default value: 0
--
spinButtonDigits :: SpinButtonClass self => Attr self Int
spinButtonDigits = newAttr
  spinButtonGetDigits
  spinButtonSetDigits

-- | Whether erroneous values are automatically changed to a spin button's
-- nearest step increment.
--
-- Default value: @False@
--
spinButtonSnapToTicks :: SpinButtonClass self => Attr self Bool
spinButtonSnapToTicks = newAttr
  spinButtonGetSnapToTicks
  spinButtonSetSnapToTicks

-- | Whether non-numeric characters should be ignored.
--
-- Default value: @False@
--
spinButtonNumeric :: SpinButtonClass self => Attr self Bool
spinButtonNumeric = newAttr
  spinButtonGetNumeric
  spinButtonSetNumeric

-- | Whether a spin button should wrap upon reaching its limits.
--
-- Default value: @False@
--
spinButtonWrap :: SpinButtonClass self => Attr self Bool
spinButtonWrap = newAttr
  spinButtonGetWrap
  spinButtonSetWrap

-- | Whether the spin button should update always, or only when the value is
-- legal.
--
-- Default value: 'UpdateAlways'
--
spinButtonUpdatePolicy :: SpinButtonClass self => Attr self SpinButtonUpdatePolicy
spinButtonUpdatePolicy = newAttr
  spinButtonGetUpdatePolicy
  spinButtonSetUpdatePolicy

-- | Reads the current value, or sets a new value.
--
-- Default value: 0
--
spinButtonValue :: SpinButtonClass self => Attr self Double
spinButtonValue = newAttr
  spinButtonGetValue
  spinButtonSetValue

--------------------
-- Signals

-- | Install a custom input handler.
--
-- * This signal is called upon each time the value of the SpinButton is set
--   by spinButtonSetValue. The function can return Nothing if the value is no
--   good.
--
onInput, afterInput :: SpinButtonClass sb => sb -> (IO (Maybe Double)) ->
                       IO (ConnectId sb)
onInput sb user = connect_PTR__INT "input" False sb $ \dPtr -> do
  mVal <- user
  case mVal of
    (Just val) -> do
      poke dPtr ((realToFrac val)::{#type gdouble#})
      return 0
    Nothing -> return (fromIntegral inputError)
afterInput sb user = connect_PTR__INT "input" True sb $ \dPtr -> do
  mVal <- user
  case mVal of
    (Just val) -> do
      poke dPtr ((realToFrac val)::{#type gdouble#})
      return 0
    Nothing -> return (fromIntegral inputError)

-- | Install a custom output handler.
--
-- * This handler makes it possible to query the current value and to render
--   something completely different to the screen using entrySetText. The
--   return value must be False in order to let the default output routine run
--   after this signal returns.
--
onOutput, afterOutput :: SpinButtonClass sb => sb -> IO Bool ->
                         IO (ConnectId sb)
onOutput = connect_NONE__BOOL "output" False
afterOutput = connect_NONE__BOOL "output" True

-- | The value of the spin button has changed.
--
onValueSpinned, afterValueSpinned :: SpinButtonClass sb => sb -> IO () ->
                                     IO (ConnectId sb)
onValueSpinned = connect_NONE__NONE "value-changed" False
afterValueSpinned = connect_NONE__NONE "value-changed" True

-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget SpinButton
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.10 $ from $Date: 2005/10/19 12:57:37 $
--
--  Copyright (C) 1999-2005 Axel Simon
--
--  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)
--
-- Retrieve an integer or floating-point number from the user
--
module Graphics.UI.Gtk.Entry.SpinButton (
-- * Detail
--
-- | A 'SpinButton' is an ideal way to allow the user to set the value of some
-- attribute. Rather than having to directly type a number into a 'Entry',
-- 'SpinButton' allows the user to click on one of two arrows to increment or
-- decrement the displayed value. A value can still be typed in, with the bonus
-- that it can be checked to ensure it is in a given range.
--
-- The main properties of a 'SpinButton' are through a 'Adjustment'. See the
-- 'Adjustment' section for more details about an adjustment's properties.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Entry'
-- |                     +----SpinButton
-- @

-- * Types
  SpinButton,
  SpinButtonClass,
  castToSpinButton,
  toSpinButton,

-- * Constructors
  spinButtonNew,
  spinButtonNewWithRange,

-- * Methods
  spinButtonConfigure,
  spinButtonSetAdjustment,
  spinButtonGetAdjustment,
  spinButtonSetDigits,
  spinButtonGetDigits,
  spinButtonSetIncrements,
  spinButtonGetIncrements,
  spinButtonSetRange,
  spinButtonGetRange,
  spinButtonGetValue,
  spinButtonGetValueAsInt,
  spinButtonSetValue,
  SpinButtonUpdatePolicy(..),
  spinButtonSetUpdatePolicy,
  spinButtonGetUpdatePolicy,
  spinButtonSetNumeric,
  spinButtonGetNumeric,
  SpinType(..),
  spinButtonSpin,
  spinButtonSetWrap,
  spinButtonGetWrap,
  spinButtonSetSnapToTicks,
  spinButtonGetSnapToTicks,
  spinButtonUpdate,

-- * Attributes
  spinButtonAdjustment,
  spinButtonClimbRate,
  spinButtonDigits,
  spinButtonSnapToTicks,
  spinButtonNumeric,
  spinButtonWrap,
  spinButtonUpdatePolicy,
  spinButtonValue,

-- * Signals
  onInput,
  afterInput,
  onOutput,
  afterOutput,
  onValueSpinned,
  afterValueSpinned
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(inputError)
import Graphics.UI.Gtk.General.Enums	(SpinButtonUpdatePolicy(..), SpinType(..))

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

--------------------
-- Interfaces

instance EditableClass SpinButton

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

-- | Creates a new 'SpinButton'.
--
spinButtonNew ::
    Adjustment    -- ^ @adjustment@ - the 'Adjustment' object that this spin
                  -- button should use.
 -> Double        -- ^ @climbRate@ - specifies how much the spin button
                  -- changes when an arrow is clicked on.
 -> Int           -- ^ @digits@ - the number of decimal places to display.
 -> IO SpinButton
spinButtonNew adjustment climbRate digits =
  makeNewObject mkSpinButton $
  liftM (castPtr :: Ptr Widget -> Ptr SpinButton) $
  {# call unsafe spin_button_new #}
    adjustment
    (realToFrac climbRate)
    (fromIntegral digits)

-- | This is a convenience constructor that allows creation of a numeric
-- 'SpinButton' without manually creating an adjustment. The value is initially
-- set to the minimum value and a page increment of 10 * @step@ is the default.
-- The precision of the spin button is equivalent to the precision of @step@.
--
-- Note that the way in which the precision is derived works best if @step@
-- is a power of ten. If the resulting precision is not suitable for your
-- needs, use 'spinButtonSetDigits' to correct it.
--
spinButtonNewWithRange ::
    Double        -- ^ @min@ - Minimum allowable value
 -> Double        -- ^ @max@ - Maximum allowable value
 -> Double        -- ^ @step@ - Increment added or subtracted by spinning the
                  -- widget
 -> IO SpinButton
spinButtonNewWithRange min max step =
  makeNewObject mkSpinButton $
  liftM (castPtr :: Ptr Widget -> Ptr SpinButton) $
  {# call unsafe spin_button_new_with_range #}
    (realToFrac min)
    (realToFrac max)
    (realToFrac step)

--------------------
-- Methods

-- | Changes the properties of an existing spin button. The adjustment, climb
-- rate, and number of decimal places are all changed accordingly, after this
-- function call.
--
spinButtonConfigure :: SpinButtonClass self => self
 -> Adjustment -- ^ @adjustment@ - a 'Adjustment'.
 -> Double     -- ^ @climbRate@ - the new climb rate.
 -> Int        -- ^ @digits@ - the number of decimal places to display in the
               -- spin button.
 -> IO ()
spinButtonConfigure self adjustment climbRate digits =
  {# call spin_button_configure #}
    (toSpinButton self)
    adjustment
    (realToFrac climbRate)
    (fromIntegral digits)

-- | Replaces the 'Adjustment' associated with the spin button.
--
spinButtonSetAdjustment :: SpinButtonClass self => self
 -> Adjustment -- ^ @adjustment@ - a 'Adjustment' to replace the existing
               -- adjustment
 -> IO ()
spinButtonSetAdjustment self adjustment =
  {# call spin_button_set_adjustment #}
    (toSpinButton self)
    adjustment

-- | Get the adjustment associated with a 'SpinButton'
--
spinButtonGetAdjustment :: SpinButtonClass self => self
 -> IO Adjustment -- ^ returns the 'Adjustment' of @spinButton@
spinButtonGetAdjustment self =
  makeNewObject mkAdjustment $
  {# call unsafe spin_button_get_adjustment #}
    (toSpinButton self)

-- | Set the precision to be displayed by @spinButton@. Up to 20 digit
-- precision is allowed.
--
spinButtonSetDigits :: SpinButtonClass self => self
 -> Int   -- ^ @digits@ - the number of digits after the decimal point to be
          -- displayed for the spin button's value
 -> IO ()
spinButtonSetDigits self digits =
  {# call spin_button_set_digits #}
    (toSpinButton self)
    (fromIntegral digits)

-- | Fetches the precision of @spinButton@. See 'spinButtonSetDigits'.
--
spinButtonGetDigits :: SpinButtonClass self => self
 -> IO Int -- ^ returns the current precision
spinButtonGetDigits self =
  liftM fromIntegral $
  {# call spin_button_get_digits #}
    (toSpinButton self)

-- | Sets the step and page increments for the spin button. This affects how
-- quickly the value changes when the spin button's arrows are activated.
--
spinButtonSetIncrements :: SpinButtonClass self => self
 -> Double -- ^ @step@ - increment applied for a button 1 press.
 -> Double -- ^ @page@ - increment applied for a button 2 press.
 -> IO ()
spinButtonSetIncrements self step page =
  {# call spin_button_set_increments #}
    (toSpinButton self)
    (realToFrac step)
    (realToFrac page)

-- | Gets the current step and page the increments used by the spin button. See
-- 'spinButtonSetIncrements'.
--
spinButtonGetIncrements :: SpinButtonClass self => self
 -> IO (Double, Double) -- ^ @(step, page)@ - step increment and page increment
spinButtonGetIncrements self =
  alloca $ \stepPtr ->
  alloca $ \pagePtr -> do
  {# call unsafe spin_button_get_increments #}
    (toSpinButton self)
    stepPtr
    pagePtr
  step <- peek stepPtr
  page <- peek pagePtr
  return (realToFrac step, realToFrac page)

-- | Sets the minimum and maximum allowable values for the spin button
--
spinButtonSetRange :: SpinButtonClass self => self
 -> Double -- ^ @min@ - minimum allowable value
 -> Double -- ^ @max@ - maximum allowable value
 -> IO ()
spinButtonSetRange self min max =
  {# call spin_button_set_range #}
    (toSpinButton self)
    (realToFrac min)
    (realToFrac max)

-- | Gets the range allowed for the spin button. See 'spinButtonSetRange'.
--
spinButtonGetRange :: SpinButtonClass self => self
 -> IO (Double, Double) -- ^ @(min, max)@ - minimum and maximum allowed value
spinButtonGetRange self =
  alloca $ \minPtr ->
  alloca $ \maxPtr -> do
  {# call unsafe spin_button_get_range #}
    (toSpinButton self)
    minPtr
    maxPtr
  min <- peek minPtr
  max <- peek maxPtr
  return (realToFrac min, realToFrac max)

-- | Get the value of the spin button as a floating point value.
--
spinButtonGetValue :: SpinButtonClass self => self -> IO Double
spinButtonGetValue self =
  liftM realToFrac $
  {# call unsafe spin_button_get_value #}
    (toSpinButton self)

-- | Get the value of the spin button as an integral value.
--
spinButtonGetValueAsInt :: SpinButtonClass self => self -> IO Int
spinButtonGetValueAsInt self =
  liftM fromIntegral $
  {# call unsafe spin_button_get_value_as_int #}
    (toSpinButton self)

-- | Set the value of the spin button.
--
spinButtonSetValue :: SpinButtonClass self => self -> Double -> IO ()
spinButtonSetValue self value =
  {# call spin_button_set_value #}
    (toSpinButton self)
    (realToFrac value)

-- | Sets the update behavior of a spin button. This determines whether the
-- spin button is always updated or only when a valid value is set.
--
spinButtonSetUpdatePolicy :: SpinButtonClass self => self
 -> SpinButtonUpdatePolicy -- ^ @policy@ - a 'SpinButtonUpdatePolicy' value
 -> IO ()
spinButtonSetUpdatePolicy self policy =
  {# call spin_button_set_update_policy #}
    (toSpinButton self)
    ((fromIntegral . fromEnum) policy)

-- | Gets the update behavior of a spin button. See
-- 'spinButtonSetUpdatePolicy'.
--
spinButtonGetUpdatePolicy :: SpinButtonClass self => self
 -> IO SpinButtonUpdatePolicy -- ^ returns the current update policy
spinButtonGetUpdatePolicy self =
  liftM (toEnum . fromIntegral) $
  {# call unsafe spin_button_get_update_policy #}
    (toSpinButton self)

-- | Sets the flag that determines if non-numeric text can be typed into the
-- spin button.
--
spinButtonSetNumeric :: SpinButtonClass self => self
 -> Bool  -- ^ @numeric@ - flag indicating if only numeric entry is allowed.
 -> IO ()
spinButtonSetNumeric self numeric =
  {# call spin_button_set_numeric #}
    (toSpinButton self)
    (fromBool numeric)

-- | Returns whether non-numeric text can be typed into the spin button. See
-- 'spinButtonSetNumeric'.
--
spinButtonGetNumeric :: SpinButtonClass self => self
 -> IO Bool -- ^ returns @True@ if only numeric text can be entered
spinButtonGetNumeric self =
  liftM toBool $
  {# call unsafe spin_button_get_numeric #}
    (toSpinButton self)

-- | Increment or decrement a spin button's value in a specified direction by
-- a specified amount.
--
spinButtonSpin :: SpinButtonClass self => self
 -> SpinType -- ^ @direction@ - a 'SpinType' indicating the direction to spin.
 -> Double   -- ^ @increment@ - step increment to apply in the specified
             -- direction.
 -> IO ()
spinButtonSpin self direction increment =
  {# call spin_button_spin #}
    (toSpinButton self)
    ((fromIntegral . fromEnum) direction)
    (realToFrac increment)

-- | Sets the flag that determines if a spin button value wraps around to the
-- opposite limit when the upper or lower limit of the range is exceeded.
--
spinButtonSetWrap :: SpinButtonClass self => self
 -> Bool  -- ^ @wrap@ - a flag indicating if wrapping behavior is performed.
 -> IO ()
spinButtonSetWrap self wrap =
  {# call spin_button_set_wrap #}
    (toSpinButton self)
    (fromBool wrap)

-- | Returns whether the spin button's value wraps around to the opposite
-- limit when the upper or lower limit of the range is exceeded. See
-- 'spinButtonSetWrap'.
--
spinButtonGetWrap :: SpinButtonClass self => self
 -> IO Bool -- ^ returns @True@ if the spin button wraps around
spinButtonGetWrap self =
  liftM toBool $
  {# call spin_button_get_wrap #}
    (toSpinButton self)

-- | Sets the policy as to whether values are corrected to the nearest step
-- increment when a spin button is activated after providing an invalid value.
--
spinButtonSetSnapToTicks :: SpinButtonClass self => self
 -> Bool  -- ^ @snapToTicks@ - a flag indicating if invalid values should be
          -- corrected.
 -> IO ()
spinButtonSetSnapToTicks self snapToTicks =
  {# call spin_button_set_snap_to_ticks #}
    (toSpinButton self)
    (fromBool snapToTicks)

-- | Returns whether the values are corrected to the nearest step. See
-- 'spinButtonSetSnapToTicks'.
--
spinButtonGetSnapToTicks :: SpinButtonClass self => self
 -> IO Bool -- ^ returns @True@ if values are snapped to the nearest step.
spinButtonGetSnapToTicks self =
  liftM toBool $
  {# call unsafe spin_button_get_snap_to_ticks #}
    (toSpinButton self)

-- | Manually force an update of the spin button.
--
spinButtonUpdate :: SpinButtonClass self => self -> IO ()
spinButtonUpdate self =
  {# call spin_button_update #}
    (toSpinButton self)

--------------------
-- Attributes

-- | The adjustment that holds the value of the spinbutton.
--
spinButtonAdjustment :: SpinButtonClass self => Attr self Adjustment
spinButtonAdjustment = newAttr
  spinButtonGetAdjustment
  spinButtonSetAdjustment

-- | The acceleration rate when you hold down a button.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
spinButtonClimbRate :: SpinButtonClass self => Attr self Double
spinButtonClimbRate = newAttrFromDoubleProperty "climb-rate"

-- | The number of decimal places to display.
--
-- Allowed values: \<= 20
--
-- Default value: 0
--
spinButtonDigits :: SpinButtonClass self => Attr self Int
spinButtonDigits = newAttr
  spinButtonGetDigits
  spinButtonSetDigits

-- | Whether erroneous values are automatically changed to a spin button's
-- nearest step increment.
--
-- Default value: @False@
--
spinButtonSnapToTicks :: SpinButtonClass self => Attr self Bool
spinButtonSnapToTicks = newAttr
  spinButtonGetSnapToTicks
  spinButtonSetSnapToTicks

-- | Whether non-numeric characters should be ignored.
--
-- Default value: @False@
--
spinButtonNumeric :: SpinButtonClass self => Attr self Bool
spinButtonNumeric = newAttr
  spinButtonGetNumeric
  spinButtonSetNumeric

-- | Whether a spin button should wrap upon reaching its limits.
--
-- Default value: @False@
--
spinButtonWrap :: SpinButtonClass self => Attr self Bool
spinButtonWrap = newAttr
  spinButtonGetWrap
  spinButtonSetWrap

-- | Whether the spin button should update always, or only when the value is
-- legal.
--
-- Default value: 'UpdateAlways'
--
spinButtonUpdatePolicy :: SpinButtonClass self => Attr self SpinButtonUpdatePolicy
spinButtonUpdatePolicy = newAttr
  spinButtonGetUpdatePolicy
  spinButtonSetUpdatePolicy

-- | Reads the current value, or sets a new value.
--
-- Default value: 0
--
spinButtonValue :: SpinButtonClass self => Attr self Double
spinButtonValue = newAttr
  spinButtonGetValue
  spinButtonSetValue

--------------------
-- Signals

-- | Install a custom input handler.
--
-- * This signal is called upon each time the value of the SpinButton is set
--   by spinButtonSetValue. The function can return Nothing if the value is no
--   good.
--
onInput, afterInput :: SpinButtonClass sb => sb -> (IO (Maybe Double)) ->
                       IO (ConnectId sb)
onInput sb user = connect_PTR__INT "input" False sb $ \dPtr -> do
  mVal <- user
  case mVal of
    (Just val) -> do
      poke dPtr ((realToFrac val)::{#type gdouble#})
      return 0
    Nothing -> return (fromIntegral inputError)
afterInput sb user = connect_PTR__INT "input" True sb $ \dPtr -> do
  mVal <- user
  case mVal of
    (Just val) -> do
      poke dPtr ((realToFrac val)::{#type gdouble#})
      return 0
    Nothing -> return (fromIntegral inputError)

-- | Install a custom output handler.
--
-- * This handler makes it possible to query the current value and to render
--   something completely different to the screen using entrySetText. The
--   return value must be False in order to let the default output routine run
--   after this signal returns.
--
onOutput, afterOutput :: SpinButtonClass sb => sb -> IO Bool ->
                         IO (ConnectId sb)
onOutput = connect_NONE__BOOL "output" False
afterOutput = connect_NONE__BOOL "output" True

-- | The value of the spin button has changed.
--
onValueSpinned, afterValueSpinned :: SpinButtonClass sb => sb -> IO () ->
                                     IO (ConnectId sb)
onValueSpinned = connect_NONE__NONE "value-changed" False
afterValueSpinned = connect_NONE__NONE "value-changed" True


glade: remove glade/Glade.chs (not sure why this file is here...)

-- GIMP Toolkit (GTK) Binding for Haskell: binding to Libglade   -*-haskell-*-
--    for loading XML widget specifications
--
--  Author : Manuel M T Chakravarty
--  Created: 13 March 2002
--
--  Copyright (c) 2002 Manuel M T Chakravarty
--  Modified 2003 by Duncan Coutts (gtk2hs port)
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
--  Libglade facilitates loading of XML specifications of whole widget trees
--  that have been interactively designed with the GUI builder Glade.  The
--  present module exports operations for manipulating 'GladeXML' objects.
--
--  @glade_xml_signal_autoconnect()@ is not supported. The C variant is not
--  suitable for Haskell as @-rdynamic@ leads to huge executable and we
--  usually don't want to connect staticly named functions, but closures.
--
-- * @glade_xml_construct()@ is not bound, as it doesn't seem to be useful
--   in Haskell.  As usual, the @signal_connect_data@ variant for
--   registering signal handlers isn't bound either.  Moreover, the
--   @connect_full@ functions are not bound.
--
-- * This binding does not support Libglade functionality that is
--   exclusively meant for extending Libglade with new widgets.  Like new
--   widgets, such functionality is currently expected to be implemented in
--   C.
--

module Glade (

  -- * Data types
  --
  GladeXMLClass, GladeXML,

  -- * Creation operations
  --
  xmlNew, xmlNewWithRootAndDomain,

  -- * Obtaining widget handles
  --
  xmlGetWidget, xmlGetWidgetRaw

) where

import Monad	(liftM)
import FFI
import GType
import Object   (makeNewObject)
import GObject  (makeNewGObject)
{#import Hierarchy#}
{#import GladeType#}
import GList

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

-- | Create a new XML object (and the corresponding
-- widgets) from the given XML file; corresponds to
-- 'xmlNewWithRootAndDomain', but without the ability to specify a root
-- widget or translation domain.
--
xmlNew :: FilePath -> IO (Maybe GladeXML)
xmlNew file =
  withCString file                $ \strPtr1 -> do
  xmlPtr <- {#call unsafe xml_new#} strPtr1 nullPtr nullPtr
  if xmlPtr==nullPtr then return Nothing
                     else liftM Just $ makeNewGObject mkGladeXML (return xmlPtr)

-- | Create a new GladeXML object (and
-- the corresponding widgets) from the given XML file with an optional
-- root widget and translation domain.
--
-- * If the second argument is not @Nothing@, the interface will only be built
--   from the widget whose name is given.  This feature is useful if you only
--   want to build say a toolbar or menu from the XML file, but not the window
--   it is embedded in.  Note also that the XML parse tree is cached to speed
--   up creating another \'XML\' object for the same file.
--
xmlNewWithRootAndDomain :: FilePath -> Maybe String -> Maybe String -> IO (Maybe GladeXML)
xmlNewWithRootAndDomain file rootWidgetName domain =
  withCString file                $ \strPtr1 ->
  withMaybeCString rootWidgetName $ \strPtr2 ->
  withMaybeCString domain         $ \strPtr3 -> do
  xmlPtr <- {#call unsafe xml_new#} strPtr1 strPtr2 strPtr3
  if xmlPtr==nullPtr then return Nothing
                     else liftM Just $ makeNewGObject mkGladeXML (return xmlPtr)

-- | Get the widget that has the given name in
-- the interface description. If the named widget cannot be found
-- or is of the wrong type the result is an error.
--
-- * the second parameter should be a dynamic cast function that
--   returns the type of object that you expect, eg castToButton
--
-- * the third parameter is the ID of the widget in the glade xml
--   file, eg \"button1\".
--
xmlGetWidget :: (WidgetClass widget) => GladeXML -> (GObject -> widget) -> String -> IO widget
xmlGetWidget xml cast name = do
  maybeWidget <- xmlGetWidgetRaw xml name
  return $ case maybeWidget of
    Just widget -> cast (toGObject widget) --the cast will return an error if the object is of the wrong type
    Nothing -> error $ "glade.xmlGetWidget: no object named " ++ show name ++ " in the glade file"

xmlGetWidgetRaw :: GladeXML -> String -> IO (Maybe Widget)
xmlGetWidgetRaw xml name =
  withCString name $ \strPtr1 -> do
  widgetPtr <- {#call unsafe xml_get_widget#} xml strPtr1
  if widgetPtr==nullPtr then return Nothing
                        else liftM Just $ makeNewObject mkWidget (return widgetPtr)

-- Auxilliary routines
-- -------------------

-- Marshall an optional string
--
withMaybeCString :: Maybe String -> (Ptr CChar -> IO a) -> IO a
withMaybeCString  = maybeWith withCString


gio: don't use Control.Monad.>=> (it's not in ghc-6.6 or earlier)

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gio -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 13-Oct-2008
--
--  Copyright (c) 2008 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/>.
--
--  GIO, 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 GIO documentation.
--
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.GIO.File (
    File,
    FileClass,
    FileQueryInfoFlags,
    FileCreateFlags,
    FileCopyFlags,
    FileMonitorFlags,
    FilesystemPreviewType,
    FileProgressCallback,
    FileReadMoreCallback,
    fileFromPath,
    fileFromURI,
    fileFromCommandlineArg,
    fileFromParseName,
    fileEqual,
    fileBasename,
    filePath,
    fileURI,
    fileParseName,
    fileGetChild,
    fileGetChildForDisplayName,
    fileHasPrefix,
    fileGetRelativePath,
    fileResolveRelativePath,
    fileIsNative,
    fileHasURIScheme,
    fileURIScheme,
    fileRead,
    fileReadAsync,
    fileReadFinish,
    fileAppendTo,
    fileCreate,
    fileReplace,
    fileAppendToAsync,
    fileAppendToFinish,
    fileCreateAsync,
    fileCreateFinish,
    fileReplaceAsync,
    fileReplaceFinish,
    fileQueryInfo,
    fileQueryInfoAsync,
    fileQueryInfoFinish,
    fileQueryExists,
    fileQueryFilesystemInfo,
    fileQueryFilesystemInfoAsync,
    fileQueryFilesystemInfoFinish,
    fileQueryDefaultHandler,
    fileFindEnclosingMount,
    fileFindEnclosingMountAsync,
    fileFindEnclosingMountFinish,
    fileEnumerateChildren,
    fileEnumerateChildrenAsync,
    fileEnumerateChildrenFinish,
    fileSetDisplayName,
    fileSetDisplayNameAsync,
    fileSetDisplayNameFinish,
    fileDelete,
    fileTrash,
    fileCopy,
    fileCopyAsync,
    fileCopyFinish,
    fileMove,
    fileMakeDirectory,
    fileMakeDirectoryWithParents,
    fileMakeSymbolicLink
    ) where

import Control.Monad
import qualified Data.ByteString as BS
import Data.Typeable

import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GError
import System.Glib.UTFString

import System.GIO.Base
{#import System.GIO.Types#}

{# context lib = "gio" prefix = "g" #}

{# enum GFileQueryInfoFlags as FileQueryInfoFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileQueryInfoFlags

{# enum GFileCreateFlags as FileCreateFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCreateFlags

{# enum GFileCopyFlags as FileCopyFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCopyFlags

{# enum GFileMonitorFlags as FileMonitorFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileMonitorFlags

{# enum GFilesystemPreviewType as FilesystemPreviewType {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}

type FileProgressCallback = Offset -> Offset -> IO ()
type CFileProgressCallback = {# type goffset #} -> {# type goffset #} -> Ptr () -> IO ()
foreign import ccall "wrapper"
    makeFileProgressCallback :: CFileProgressCallback
                             -> IO {# type GFileProgressCallback #}

marshalFileProgressCallback :: FileProgressCallback -> IO {# type GFileProgressCallback #}
marshalFileProgressCallback fileProgressCallback =
    makeFileProgressCallback cFileProgressCallback
    where cFileProgressCallback :: CFileProgressCallback
          cFileProgressCallback cCurrentNumBytes cTotalNumBytes _ = do
            fileProgressCallback (fromIntegral cCurrentNumBytes)
                                 (fromIntegral cTotalNumBytes)

type FileReadMoreCallback = BS.ByteString -> IO Bool

fileFromPath :: FilePath -> File
fileFromPath path =
    unsafePerformIO $ withUTFString path $ \cPath -> {# call file_new_for_path #} cPath >>= takeGObject

fileFromURI :: String -> File
fileFromURI uri =
    unsafePerformIO $ withUTFString uri $ \cURI -> {# call file_new_for_uri #} cURI >>= takeGObject

fileFromCommandlineArg :: String -> File
fileFromCommandlineArg arg =
    unsafePerformIO $ withUTFString arg $ \cArg -> {# call file_new_for_commandline_arg #} cArg >>= takeGObject

fileFromParseName :: String -> File
fileFromParseName parseName =
    unsafePerformIO $ withUTFString parseName $ \cParseName -> {# call file_parse_name #} cParseName >>= takeGObject

fileEqual :: (FileClass file1, FileClass file2)
          => file1 -> file2 -> Bool
fileEqual file1 file2 =
    unsafePerformIO $ liftM toBool $ {# call file_equal #} (toFile file1) (toFile file2)

instance Eq File where
    (==) = fileEqual

fileBasename :: FileClass file => file -> String
fileBasename file =
    unsafePerformIO $ {# call file_get_basename #} (toFile file) >>= readUTFString

filePath :: FileClass file => file -> FilePath
filePath file =
    unsafePerformIO $ {# call file_get_path #} (toFile file) >>= readUTFString

fileURI :: FileClass file => file -> String
fileURI file =
    unsafePerformIO $ {# call file_get_uri #} (toFile file) >>= readUTFString

fileParseName :: FileClass file => file -> String
fileParseName file =
    unsafePerformIO $ {# call file_get_parse_name #} (toFile file) >>= readUTFString

fileParent :: FileClass file => file -> Maybe File
fileParent file =
    unsafePerformIO $ {# call file_get_parent #} (toFile file) >>= maybePeek takeGObject

fileGetChild :: FileClass file => file -> String -> File
fileGetChild file name =
    unsafePerformIO $
        withUTFString name $ \cName ->
        {# call file_get_child #} (toFile file) cName >>= takeGObject

fileGetChildForDisplayName :: FileClass file => file -> String -> Maybe File
fileGetChildForDisplayName file displayName =
    unsafePerformIO $
        withUTFString displayName $ \cDisplayName ->
        propagateGError ({# call file_get_child_for_display_name #} (toFile file) cDisplayName) >>=
        maybePeek takeGObject

fileHasPrefix :: (FileClass file1, FileClass file2) => file1 -> file2 -> Bool
fileHasPrefix file1 file2 =
    unsafePerformIO $
        liftM toBool $ {# call file_has_prefix #} (toFile file1) (toFile file2)

fileGetRelativePath :: (FileClass file1, FileClass file2) => file1 -> file2 -> Maybe FilePath
fileGetRelativePath file1 file2 =
    unsafePerformIO $
        {# call file_get_relative_path #} (toFile file1) (toFile file2) >>=
        maybePeek readUTFString

fileResolveRelativePath :: FileClass file => file -> FilePath -> Maybe File
fileResolveRelativePath file relativePath =
    unsafePerformIO $
        withUTFString relativePath $ \cRelativePath ->
        {# call file_resolve_relative_path #} (toFile file) cRelativePath >>=
        maybePeek takeGObject

fileIsNative :: FileClass file => file -> Bool
fileIsNative =
    unsafePerformIO .
        liftM toBool . {# call file_is_native #} . toFile

fileHasURIScheme :: FileClass file => file -> String -> Bool
fileHasURIScheme file uriScheme =
    unsafePerformIO $
        withUTFString uriScheme $ \cURIScheme ->
        liftM toBool $ {# call file_has_uri_scheme #} (toFile file) cURIScheme

fileURIScheme :: FileClass file => file -> String
fileURIScheme file =
    unsafePerformIO $ {# call file_get_uri_scheme #} (toFile file) >>= readUTFString

fileRead :: FileClass file => file -> Maybe Cancellable -> IO FileInputStream
fileRead file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            propagateGError (g_file_read cFile cCancellable) >>= takeGObject
    where _ = {# call file_read #}

fileReadAsync :: FileClass file
              => file
              -> Int
              -> Maybe Cancellable
              -> AsyncReadyCallback
              -> IO ()
fileReadAsync file ioPriority mbCancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject mbCancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_read_async cFile
                            (fromIntegral ioPriority)
                            cCancellable
                            cCallback
                            (castFunPtrToPtr cCallback)
    where _ = {# call file_read_async #}

fileReadFinish :: FileClass file
               => file
               -> AsyncResult
               -> IO FileInputStream
fileReadFinish file asyncResult =
    propagateGError ({# call file_read_finish #} (toFile file) asyncResult) >>= takeGObject

fileAppendTo :: FileClass file
             => file
             -> [FileCreateFlags]
             -> Maybe Cancellable
             -> IO FileOutputStream
fileAppendTo file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_append_to cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_append_to #}

fileCreate :: FileClass file
           => file
           -> [FileCreateFlags]
           -> Maybe Cancellable
           -> IO FileOutputStream
fileCreate file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_create cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_create #}

fileReplace :: FileClass file
            => file
            -> Maybe String
            -> Bool
            -> [FileCreateFlags]
            -> Maybe Cancellable
            -> IO FileOutputStream
fileReplace file etag makeBackup flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_replace cFile
                                        cEtag
                                        (fromBool makeBackup)
                                        (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_replace #}

fileAppendToAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileAppendToAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_append_to_async cFile
                                 (cFromFlags flags)
                                 (fromIntegral ioPriority)
                                 cCancellable
                                 cCallback
                                 (castFunPtrToPtr cCallback)
    where _ = {# call file_append_to_async #}

fileAppendToFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileAppendToFinish file asyncResult =
    propagateGError ({# call file_append_to_finish #} (toFile file) asyncResult) >>= takeGObject

fileCreateAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileCreateAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_create_async cFile
                              (cFromFlags flags)
                              (fromIntegral ioPriority)
                              cCancellable
                              cCallback
                              (castFunPtrToPtr cCallback)
    where _ = {# call file_create_async #}

fileCreateFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileCreateFinish file asyncResult =
    propagateGError ({# call file_create_finish #} (toFile file) asyncResult) >>= takeGObject

fileReplaceAsync :: FileClass file
                 => file
                 -> String
                 -> Bool
                 -> [FileCreateFlags]
                 -> Int
                 -> Maybe Cancellable
                 -> AsyncReadyCallback
                 -> IO ()
fileReplaceAsync file etag makeBackup flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_replace_async cFile
                               cEtag
                               (fromBool makeBackup)
                               (cFromFlags flags)
                               (fromIntegral ioPriority)
                               cCancellable
                               cCallback
                               (castFunPtrToPtr cCallback)
    where _ = {# call file_replace_async #}

fileReplaceFinish :: FileClass file
                  => file
                  -> AsyncResult
                  -> IO FileOutputStream
fileReplaceFinish file asyncResult =
    propagateGError ({# call file_replace_finish #} (toFile file) asyncResult) >>= takeGObject

fileQueryInfo :: FileClass file
              => file
              -> String
              -> [FileQueryInfoFlags]
              -> Maybe Cancellable
              -> IO FileInfo
fileQueryInfo file attributes flags cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_info cFile cAttributes (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_query_info #}

fileQueryInfoAsync :: FileClass file
                   => file
                   -> String
                   -> [FileQueryInfoFlags]
                   -> Int
                   -> Maybe Cancellable
                   -> AsyncReadyCallback
                   -> IO ()
fileQueryInfoAsync file attributes flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_query_info_async cFile
                                  cAttributes
                                  (cFromFlags flags)
                                  (fromIntegral ioPriority)
                                  cCancellable
                                  cCallback
                                  (castFunPtrToPtr cCallback)
    where _ = {# call file_query_info_async #}

fileQueryInfoFinish :: FileClass file
                    => file
                    -> AsyncResult
                    -> IO FileInfo
fileQueryInfoFinish file asyncResult =
    propagateGError ({#call file_query_info_finish #} (toFile file) asyncResult) >>= takeGObject

fileQueryExists :: FileClass file
                => file
                -> Maybe Cancellable
                -> IO Bool
fileQueryExists file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            liftM toBool $ g_file_query_exists cFile cCancellable
    where _ = {# call file_query_exists #}

fileQueryFilesystemInfo :: FileClass file
                        => file
                        -> String
                        -> Maybe Cancellable
                        -> IO FileInfo
fileQueryFilesystemInfo file attributes cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_filesystem_info cFile cAttributes cCancellable) >>=
        takeGObject
    where _ = {# call file_query_filesystem_info #}

fileQueryFilesystemInfoAsync :: FileClass file
                             => file
                             -> String
                             -> Int
                             -> Maybe Cancellable
                             -> AsyncReadyCallback
                             -> IO ()
fileQueryFilesystemInfoAsync file attributes ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_query_filesystem_info_async cFile
                                             cAttributes
                                             (fromIntegral ioPriority)
                                             cCancellable
                                             cCallback
                                             (castFunPtrToPtr cCallback)
    where _ = {# call file_query_filesystem_info_async #}

fileQueryFilesystemInfoFinish :: FileClass file
                              => file
                              -> AsyncResult
                              -> IO FileInfo
fileQueryFilesystemInfoFinish file asyncResult =
    propagateGError ({# call file_query_filesystem_info_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileQueryDefaultHandler :: FileClass file
                        => file
                        -> Maybe Cancellable
                        -> IO AppInfo
fileQueryDefaultHandler file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_default_handler cFile cCancellable) >>=
        takeGObject
    where _ = {# call file_query_default_handler #}

fileFindEnclosingMount :: FileClass file
                       => file
                       -> Maybe Cancellable
                       -> IO Mount
fileFindEnclosingMount file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_find_enclosing_mount cFile cCancellable) >>=
        takeGObject
    where _ = {# call file_find_enclosing_mount #}

fileFindEnclosingMountAsync :: FileClass file
                            => file
                            -> Int
                            -> Maybe Cancellable
                            -> AsyncReadyCallback
                            -> IO ()
fileFindEnclosingMountAsync file ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_find_enclosing_mount_async cFile
                                            (fromIntegral ioPriority)
                                            cCancellable
                                            cCallback
                                            (castFunPtrToPtr cCallback)
    where _ = {# call file_find_enclosing_mount_async #}

fileFindEnclosingMountFinish :: FileClass file
                             => file
                             -> AsyncResult
                             -> IO Mount
fileFindEnclosingMountFinish file asyncResult =
    propagateGError ({# call file_find_enclosing_mount_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileEnumerateChildren :: FileClass file
                      => file
                      -> String
                      -> [FileQueryInfoFlags]
                      -> Maybe Cancellable
                      -> IO FileEnumerator
fileEnumerateChildren file attributes flags cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_enumerate_children cFile cAttributes (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_enumerate_children #}

fileEnumerateChildrenAsync :: FileClass file
                           => file
                           -> String
                           -> [FileQueryInfoFlags]
                           -> Int
                           -> Maybe Cancellable
                           -> AsyncReadyCallback
                           -> IO ()
fileEnumerateChildrenAsync file attributes flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_enumerate_children_async cFile
                                          cAttributes
                                          (cFromFlags flags)
                                          (fromIntegral ioPriority)
                                          cCancellable
                                          cCallback
                                          (castFunPtrToPtr cCallback)
    where _ = {# call file_enumerate_children_async #}

fileEnumerateChildrenFinish :: FileClass file
                             => file
                             -> AsyncResult
                             -> IO FileEnumerator
fileEnumerateChildrenFinish file asyncResult =
    propagateGError ({# call file_enumerate_children_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileSetDisplayName :: FileClass file
                   => file
                   -> String
                   -> Maybe Cancellable
                   -> IO File
fileSetDisplayName file displayName cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString displayName $ \cDisplayName ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_set_display_name cFile cDisplayName cCancellable) >>=
        takeGObject
    where _ = {# call file_set_display_name #}

fileSetDisplayNameAsync :: FileClass file
                        => file
                        -> String
                        -> Int
                        -> Maybe Cancellable
                        -> AsyncReadyCallback
                        -> IO ()
fileSetDisplayNameAsync file displayName ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString displayName $ \cDisplayName ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_set_display_name_async cFile
                                        cDisplayName
                                        (fromIntegral ioPriority)
                                        cCancellable
                                        cCallback
                                        (castFunPtrToPtr cCallback)
    where _ = {# call file_set_display_name_async #}

fileSetDisplayNameFinish :: FileClass file
                         => file
                         -> AsyncResult
                         -> IO File
fileSetDisplayNameFinish file asyncResult =
    propagateGError ({# call file_set_display_name_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileDelete :: FileClass file
           => file
           -> Maybe Cancellable
           -> IO ()
fileDelete file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_delete cFile cCancellable) >> return ()
    where _ = {# call file_delete #}

fileTrash :: FileClass file
           => file
           -> Maybe Cancellable
           -> IO ()
fileTrash file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_trash cFile cCancellable) >> return ()
    where _ = {# call file_trash #}

fileCopy :: (FileClass source, FileClass destination)
         => source
         -> destination
         -> [FileCopyFlags]
         -> Maybe Cancellable
         -> Maybe FileProgressCallback
         -> IO Bool
fileCopy source destination flags cancellable progressCallback =
    withGObject (toFile source) $ \cSource ->
        withGObject (toFile destination) $ \cDestination ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cProgressCallback <- maybe (return nullFunPtr) marshalFileProgressCallback progressCallback
          propagateGError $ \cError -> do
            ret <- g_file_copy cSource
                               cDestination
                               (cFromFlags flags)
                               cCancellable
                               cProgressCallback
                               nullPtr
                               cError
            freeHaskellFunPtr cProgressCallback
            return $ toBool ret
    where _ = {# call file_copy #}

fileCopyAsync :: (FileClass source, FileClass destination)
              => source
              -> destination
              -> [FileCopyFlags]
              -> Int
              -> Maybe Cancellable
              -> Maybe FileProgressCallback
              -> AsyncReadyCallback
              -> IO ()
fileCopyAsync source destination flags ioPriority cancellable progressCallback callback =
    withGObject (toFile source) $ \cSource ->
        withGObject (toFile destination) $ \cDestination ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cProgressCallback <- maybe (return nullFunPtr) marshalFileProgressCallback progressCallback
          cCallback <- marshalAsyncReadyCallback $ \sourceObject res -> do
                         freeHaskellFunPtr cProgressCallback
                         callback sourceObject res
          g_file_copy_async cSource
                            cDestination
                            (cFromFlags flags)
                            (fromIntegral ioPriority)
                            cCancellable
                            cProgressCallback
                            nullPtr
                            cCallback
                            (castFunPtrToPtr cCallback)
    where _ = {# call file_copy_async #}

fileCopyFinish :: FileClass file
               => file
               -> AsyncResult
               -> IO Bool
fileCopyFinish file asyncResult =
    liftM toBool $ propagateGError ({# call file_copy_finish #} (toFile file) asyncResult)

fileMove :: (FileClass source, FileClass destination)
         => source
         -> destination
         -> [FileCopyFlags]
         -> Maybe Cancellable
         -> Maybe FileProgressCallback
         -> IO Bool
fileMove source destination flags cancellable progressCallback =
    withGObject (toFile source) $ \cSource ->
        withGObject (toFile destination) $ \cDestination ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cProgressCallback <- maybe (return nullFunPtr) marshalFileProgressCallback progressCallback
          propagateGError $ \cError -> do
            ret <- g_file_move cSource
                               cDestination
                               (cFromFlags flags)
                               cCancellable
                               cProgressCallback
                               nullPtr
                               cError
            freeHaskellFunPtr cProgressCallback
            return $ toBool ret
    where _ = {# call file_move #}

fileMakeDirectory :: FileClass file
                  => file
                  -> Maybe Cancellable
                  -> IO ()
fileMakeDirectory file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          propagateGError $ g_file_make_directory cFile cCancellable
          return ()
    where _ = {# call file_make_directory #}

fileMakeDirectoryWithParents :: FileClass file
                             => file
                             -> Maybe Cancellable
                             -> IO ()
fileMakeDirectoryWithParents file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          propagateGError $ g_file_make_directory_with_parents cFile cCancellable
          return ()
    where _ = {# call file_make_directory_with_parents #}

fileMakeSymbolicLink :: FileClass file
                     => file
                     -> String
                     -> Maybe Cancellable
                     -> IO ()
fileMakeSymbolicLink file symlinkValue cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString symlinkValue $ \cSymlinkValue ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          propagateGError $ g_file_make_symbolic_link cFile cSymlinkValue cCancellable
          return ()
    where _ = {# call file_make_symbolic_link #}

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gio -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 13-Oct-2008
--
--  Copyright (c) 2008 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/>.
--
--  GIO, 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 GIO documentation.
--
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module System.GIO.File (
    File,
    FileClass,
    FileQueryInfoFlags,
    FileCreateFlags,
    FileCopyFlags,
    FileMonitorFlags,
    FilesystemPreviewType,
    FileProgressCallback,
    FileReadMoreCallback,
    fileFromPath,
    fileFromURI,
    fileFromCommandlineArg,
    fileFromParseName,
    fileEqual,
    fileBasename,
    filePath,
    fileURI,
    fileParseName,
    fileGetChild,
    fileGetChildForDisplayName,
    fileHasPrefix,
    fileGetRelativePath,
    fileResolveRelativePath,
    fileIsNative,
    fileHasURIScheme,
    fileURIScheme,
    fileRead,
    fileReadAsync,
    fileReadFinish,
    fileAppendTo,
    fileCreate,
    fileReplace,
    fileAppendToAsync,
    fileAppendToFinish,
    fileCreateAsync,
    fileCreateFinish,
    fileReplaceAsync,
    fileReplaceFinish,
    fileQueryInfo,
    fileQueryInfoAsync,
    fileQueryInfoFinish,
    fileQueryExists,
    fileQueryFilesystemInfo,
    fileQueryFilesystemInfoAsync,
    fileQueryFilesystemInfoFinish,
    fileQueryDefaultHandler,
    fileFindEnclosingMount,
    fileFindEnclosingMountAsync,
    fileFindEnclosingMountFinish,
    fileEnumerateChildren,
    fileEnumerateChildrenAsync,
    fileEnumerateChildrenFinish,
    fileSetDisplayName,
    fileSetDisplayNameAsync,
    fileSetDisplayNameFinish,
    fileDelete,
    fileTrash,
    fileCopy,
    fileCopyAsync,
    fileCopyFinish,
    fileMove,
    fileMakeDirectory,
    fileMakeDirectoryWithParents,
    fileMakeSymbolicLink
    ) where

import Control.Monad
import qualified Data.ByteString as BS
import Data.Typeable

import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GError
import System.Glib.UTFString

import System.GIO.Base
{#import System.GIO.Types#}

{# context lib = "gio" prefix = "g" #}

{# enum GFileQueryInfoFlags as FileQueryInfoFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileQueryInfoFlags

{# enum GFileCreateFlags as FileCreateFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCreateFlags

{# enum GFileCopyFlags as FileCopyFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileCopyFlags

{# enum GFileMonitorFlags as FileMonitorFlags {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}
instance Flags FileMonitorFlags

{# enum GFilesystemPreviewType as FilesystemPreviewType {underscoreToCase} with prefix = "G" deriving (Eq, Ord, Bounded, Show, Typeable) #}

type FileProgressCallback = Offset -> Offset -> IO ()
type CFileProgressCallback = {# type goffset #} -> {# type goffset #} -> Ptr () -> IO ()
foreign import ccall "wrapper"
    makeFileProgressCallback :: CFileProgressCallback
                             -> IO {# type GFileProgressCallback #}

marshalFileProgressCallback :: FileProgressCallback -> IO {# type GFileProgressCallback #}
marshalFileProgressCallback fileProgressCallback =
    makeFileProgressCallback cFileProgressCallback
    where cFileProgressCallback :: CFileProgressCallback
          cFileProgressCallback cCurrentNumBytes cTotalNumBytes _ = do
            fileProgressCallback (fromIntegral cCurrentNumBytes)
                                 (fromIntegral cTotalNumBytes)

type FileReadMoreCallback = BS.ByteString -> IO Bool

fileFromPath :: FilePath -> File
fileFromPath path =
    unsafePerformIO $ withUTFString path $ {# call file_new_for_path #} >=> takeGObject

fileFromURI :: String -> File
fileFromURI uri =
    unsafePerformIO $ withUTFString uri $ {# call file_new_for_uri #} >=> takeGObject

fileFromCommandlineArg :: String -> File
fileFromCommandlineArg arg =
    unsafePerformIO $ withUTFString arg $ {# call file_new_for_commandline_arg #} >=> takeGObject

fileFromParseName :: String -> File
fileFromParseName parseName =
    unsafePerformIO $ withUTFString parseName $ {# call file_parse_name #} >=> takeGObject

fileEqual :: (FileClass file1, FileClass file2)
          => file1 -> file2 -> Bool
fileEqual file1 file2 =
    unsafePerformIO $ liftM toBool $ {# call file_equal #} (toFile file1) (toFile file2)

instance Eq File where
    (==) = fileEqual

fileBasename :: FileClass file => file -> String
fileBasename =
    unsafePerformIO . ({# call file_get_basename #} . toFile >=> readUTFString)

filePath :: FileClass file => file -> FilePath
filePath =
    unsafePerformIO . ({# call file_get_path #} . toFile >=> readUTFString)

fileURI :: FileClass file => file -> String
fileURI =
    unsafePerformIO . ({# call file_get_uri #} . toFile >=> readUTFString)

fileParseName :: FileClass file => file -> String
fileParseName =
    unsafePerformIO . ({# call file_get_parse_name #} . toFile >=> readUTFString)

fileParent :: FileClass file => file -> Maybe File
fileParent =
    unsafePerformIO . ({# call file_get_parent #} . toFile >=> maybePeek takeGObject)

fileGetChild :: FileClass file => file -> String -> File
fileGetChild file name =
    unsafePerformIO $
        withUTFString name $
        {# call file_get_child #} (toFile file) >=> takeGObject

fileGetChildForDisplayName :: FileClass file => file -> String -> Maybe File
fileGetChildForDisplayName file displayName =
    unsafePerformIO $
        withUTFString displayName $ \cDisplayName ->
        propagateGError ({# call file_get_child_for_display_name #} (toFile file) cDisplayName) >>=
        maybePeek takeGObject

fileHasPrefix :: (FileClass file1, FileClass file2) => file1 -> file2 -> Bool
fileHasPrefix file1 file2 =
    unsafePerformIO $
        liftM toBool $ {# call file_has_prefix #} (toFile file1) (toFile file2)

fileGetRelativePath :: (FileClass file1, FileClass file2) => file1 -> file2 -> Maybe FilePath
fileGetRelativePath file1 file2 =
    unsafePerformIO $
        {# call file_get_relative_path #} (toFile file1) (toFile file2) >>=
        maybePeek readUTFString

fileResolveRelativePath :: FileClass file => file -> FilePath -> Maybe File
fileResolveRelativePath file relativePath =
    unsafePerformIO $
        withUTFString relativePath $ \cRelativePath ->
        {# call file_resolve_relative_path #} (toFile file) cRelativePath >>=
        maybePeek takeGObject

fileIsNative :: FileClass file => file -> Bool
fileIsNative =
    unsafePerformIO .
        liftM toBool . {# call file_is_native #} . toFile

fileHasURIScheme :: FileClass file => file -> String -> Bool
fileHasURIScheme file uriScheme =
    unsafePerformIO $
        withUTFString uriScheme $ \cURIScheme ->
        liftM toBool $ {# call file_has_uri_scheme #} (toFile file) cURIScheme

fileURIScheme :: FileClass file => file -> String
fileURIScheme =
    unsafePerformIO . ({# call file_get_uri_scheme #} . toFile >=> readUTFString)

fileRead :: FileClass file => file -> Maybe Cancellable -> IO FileInputStream
fileRead file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            propagateGError (g_file_read cFile cCancellable) >>= takeGObject
    where _ = {# call file_read #}

fileReadAsync :: FileClass file
              => file
              -> Int
              -> Maybe Cancellable
              -> AsyncReadyCallback
              -> IO ()
fileReadAsync file ioPriority mbCancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject mbCancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_read_async cFile
                            (fromIntegral ioPriority)
                            cCancellable
                            cCallback
                            (castFunPtrToPtr cCallback)
    where _ = {# call file_read_async #}

fileReadFinish :: FileClass file
               => file
               -> AsyncResult
               -> IO FileInputStream
fileReadFinish file asyncResult =
    propagateGError ({# call file_read_finish #} (toFile file) asyncResult) >>= takeGObject

fileAppendTo :: FileClass file
             => file
             -> [FileCreateFlags]
             -> Maybe Cancellable
             -> IO FileOutputStream
fileAppendTo file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_append_to cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_append_to #}

fileCreate :: FileClass file
           => file
           -> [FileCreateFlags]
           -> Maybe Cancellable
           -> IO FileOutputStream
fileCreate file flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_create cFile (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_create #}

fileReplace :: FileClass file
            => file
            -> Maybe String
            -> Bool
            -> [FileCreateFlags]
            -> Maybe Cancellable
            -> IO FileOutputStream
fileReplace file etag makeBackup flags cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_replace cFile
                                        cEtag
                                        (fromBool makeBackup)
                                        (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_replace #}

fileAppendToAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileAppendToAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_append_to_async cFile
                                 (cFromFlags flags)
                                 (fromIntegral ioPriority)
                                 cCancellable
                                 cCallback
                                 (castFunPtrToPtr cCallback)
    where _ = {# call file_append_to_async #}

fileAppendToFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileAppendToFinish file asyncResult =
    propagateGError ({# call file_append_to_finish #} (toFile file) asyncResult) >>= takeGObject

fileCreateAsync :: FileClass file
                  => file
                  -> [FileCreateFlags]
                  -> Int
                  -> Maybe Cancellable
                  -> AsyncReadyCallback
                  -> IO ()
fileCreateAsync file flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_create_async cFile
                              (cFromFlags flags)
                              (fromIntegral ioPriority)
                              cCancellable
                              cCallback
                              (castFunPtrToPtr cCallback)
    where _ = {# call file_create_async #}

fileCreateFinish :: FileClass file
                   => file
                   -> AsyncResult
                   -> IO FileOutputStream
fileCreateFinish file asyncResult =
    propagateGError ({# call file_create_finish #} (toFile file) asyncResult) >>= takeGObject

fileReplaceAsync :: FileClass file
                 => file
                 -> String
                 -> Bool
                 -> [FileCreateFlags]
                 -> Int
                 -> Maybe Cancellable
                 -> AsyncReadyCallback
                 -> IO ()
fileReplaceAsync file etag makeBackup flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString etag $ \cEtag ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_replace_async cFile
                               cEtag
                               (fromBool makeBackup)
                               (cFromFlags flags)
                               (fromIntegral ioPriority)
                               cCancellable
                               cCallback
                               (castFunPtrToPtr cCallback)
    where _ = {# call file_replace_async #}

fileReplaceFinish :: FileClass file
                  => file
                  -> AsyncResult
                  -> IO FileOutputStream
fileReplaceFinish file asyncResult =
    propagateGError ({# call file_replace_finish #} (toFile file) asyncResult) >>= takeGObject

fileQueryInfo :: FileClass file
              => file
              -> String
              -> [FileQueryInfoFlags]
              -> Maybe Cancellable
              -> IO FileInfo
fileQueryInfo file attributes flags cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_info cFile cAttributes (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_query_info #}

fileQueryInfoAsync :: FileClass file
                   => file
                   -> String
                   -> [FileQueryInfoFlags]
                   -> Int
                   -> Maybe Cancellable
                   -> AsyncReadyCallback
                   -> IO ()
fileQueryInfoAsync file attributes flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_query_info_async cFile
                                  cAttributes
                                  (cFromFlags flags)
                                  (fromIntegral ioPriority)
                                  cCancellable
                                  cCallback
                                  (castFunPtrToPtr cCallback)
    where _ = {# call file_query_info_async #}

fileQueryInfoFinish :: FileClass file
                    => file
                    -> AsyncResult
                    -> IO FileInfo
fileQueryInfoFinish file asyncResult =
    propagateGError ({#call file_query_info_finish #} (toFile file) asyncResult) >>= takeGObject

fileQueryExists :: FileClass file
                => file
                -> Maybe Cancellable
                -> IO Bool
fileQueryExists file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
            liftM toBool $ g_file_query_exists cFile cCancellable
    where _ = {# call file_query_exists #}

fileQueryFilesystemInfo :: FileClass file
                        => file
                        -> String
                        -> Maybe Cancellable
                        -> IO FileInfo
fileQueryFilesystemInfo file attributes cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_filesystem_info cFile cAttributes cCancellable) >>=
        takeGObject
    where _ = {# call file_query_filesystem_info #}

fileQueryFilesystemInfoAsync :: FileClass file
                             => file
                             -> String
                             -> Int
                             -> Maybe Cancellable
                             -> AsyncReadyCallback
                             -> IO ()
fileQueryFilesystemInfoAsync file attributes ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_query_filesystem_info_async cFile
                                             cAttributes
                                             (fromIntegral ioPriority)
                                             cCancellable
                                             cCallback
                                             (castFunPtrToPtr cCallback)
    where _ = {# call file_query_filesystem_info_async #}

fileQueryFilesystemInfoFinish :: FileClass file
                              => file
                              -> AsyncResult
                              -> IO FileInfo
fileQueryFilesystemInfoFinish file asyncResult =
    propagateGError ({# call file_query_filesystem_info_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileQueryDefaultHandler :: FileClass file
                        => file
                        -> Maybe Cancellable
                        -> IO AppInfo
fileQueryDefaultHandler file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_query_default_handler cFile cCancellable) >>=
        takeGObject
    where _ = {# call file_query_default_handler #}

fileFindEnclosingMount :: FileClass file
                       => file
                       -> Maybe Cancellable
                       -> IO Mount
fileFindEnclosingMount file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_find_enclosing_mount cFile cCancellable) >>=
        takeGObject
    where _ = {# call file_find_enclosing_mount #}

fileFindEnclosingMountAsync :: FileClass file
                            => file
                            -> Int
                            -> Maybe Cancellable
                            -> AsyncReadyCallback
                            -> IO ()
fileFindEnclosingMountAsync file ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_find_enclosing_mount_async cFile
                                            (fromIntegral ioPriority)
                                            cCancellable
                                            cCallback
                                            (castFunPtrToPtr cCallback)
    where _ = {# call file_find_enclosing_mount_async #}

fileFindEnclosingMountFinish :: FileClass file
                             => file
                             -> AsyncResult
                             -> IO Mount
fileFindEnclosingMountFinish file asyncResult =
    propagateGError ({# call file_find_enclosing_mount_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileEnumerateChildren :: FileClass file
                      => file
                      -> String
                      -> [FileQueryInfoFlags]
                      -> Maybe Cancellable
                      -> IO FileEnumerator
fileEnumerateChildren file attributes flags cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_enumerate_children cFile cAttributes (cFromFlags flags) cCancellable) >>=
        takeGObject
    where _ = {# call file_enumerate_children #}

fileEnumerateChildrenAsync :: FileClass file
                           => file
                           -> String
                           -> [FileQueryInfoFlags]
                           -> Int
                           -> Maybe Cancellable
                           -> AsyncReadyCallback
                           -> IO ()
fileEnumerateChildrenAsync file attributes flags ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString attributes $ \cAttributes ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_enumerate_children_async cFile
                                          cAttributes
                                          (cFromFlags flags)
                                          (fromIntegral ioPriority)
                                          cCancellable
                                          cCallback
                                          (castFunPtrToPtr cCallback)
    where _ = {# call file_enumerate_children_async #}

fileEnumerateChildrenFinish :: FileClass file
                             => file
                             -> AsyncResult
                             -> IO FileEnumerator
fileEnumerateChildrenFinish file asyncResult =
    propagateGError ({# call file_enumerate_children_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileSetDisplayName :: FileClass file
                   => file
                   -> String
                   -> Maybe Cancellable
                   -> IO File
fileSetDisplayName file displayName cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString displayName $ \cDisplayName ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_set_display_name cFile cDisplayName cCancellable) >>=
        takeGObject
    where _ = {# call file_set_display_name #}

fileSetDisplayNameAsync :: FileClass file
                        => file
                        -> String
                        -> Int
                        -> Maybe Cancellable
                        -> AsyncReadyCallback
                        -> IO ()
fileSetDisplayNameAsync file displayName ioPriority cancellable callback =
    withGObject (toFile file) $ \cFile ->
        withUTFString displayName $ \cDisplayName ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cCallback <- marshalAsyncReadyCallback callback
          g_file_set_display_name_async cFile
                                        cDisplayName
                                        (fromIntegral ioPriority)
                                        cCancellable
                                        cCallback
                                        (castFunPtrToPtr cCallback)
    where _ = {# call file_set_display_name_async #}

fileSetDisplayNameFinish :: FileClass file
                         => file
                         -> AsyncResult
                         -> IO File
fileSetDisplayNameFinish file asyncResult =
    propagateGError ({# call file_set_display_name_finish #} (toFile file) asyncResult) >>=
        takeGObject

fileDelete :: FileClass file
           => file
           -> Maybe Cancellable
           -> IO ()
fileDelete file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_delete cFile cCancellable) >> return ()
    where _ = {# call file_delete #}

fileTrash :: FileClass file
           => file
           -> Maybe Cancellable
           -> IO ()
fileTrash file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable ->
        propagateGError (g_file_trash cFile cCancellable) >> return ()
    where _ = {# call file_trash #}

fileCopy :: (FileClass source, FileClass destination)
         => source
         -> destination
         -> [FileCopyFlags]
         -> Maybe Cancellable
         -> Maybe FileProgressCallback
         -> IO Bool
fileCopy source destination flags cancellable progressCallback =
    withGObject (toFile source) $ \cSource ->
        withGObject (toFile destination) $ \cDestination ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cProgressCallback <- maybe (return nullFunPtr) marshalFileProgressCallback progressCallback
          propagateGError $ \cError -> do
            ret <- g_file_copy cSource
                               cDestination
                               (cFromFlags flags)
                               cCancellable
                               cProgressCallback
                               nullPtr
                               cError
            freeHaskellFunPtr cProgressCallback
            return $ toBool ret
    where _ = {# call file_copy #}

fileCopyAsync :: (FileClass source, FileClass destination)
              => source
              -> destination
              -> [FileCopyFlags]
              -> Int
              -> Maybe Cancellable
              -> Maybe FileProgressCallback
              -> AsyncReadyCallback
              -> IO ()
fileCopyAsync source destination flags ioPriority cancellable progressCallback callback =
    withGObject (toFile source) $ \cSource ->
        withGObject (toFile destination) $ \cDestination ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cProgressCallback <- maybe (return nullFunPtr) marshalFileProgressCallback progressCallback
          cCallback <- marshalAsyncReadyCallback $ \sourceObject res -> do
                         freeHaskellFunPtr cProgressCallback
                         callback sourceObject res
          g_file_copy_async cSource
                            cDestination
                            (cFromFlags flags)
                            (fromIntegral ioPriority)
                            cCancellable
                            cProgressCallback
                            nullPtr
                            cCallback
                            (castFunPtrToPtr cCallback)
    where _ = {# call file_copy_async #}

fileCopyFinish :: FileClass file
               => file
               -> AsyncResult
               -> IO Bool
fileCopyFinish file asyncResult =
    liftM toBool $ propagateGError ({# call file_copy_finish #} (toFile file) asyncResult)

fileMove :: (FileClass source, FileClass destination)
         => source
         -> destination
         -> [FileCopyFlags]
         -> Maybe Cancellable
         -> Maybe FileProgressCallback
         -> IO Bool
fileMove source destination flags cancellable progressCallback =
    withGObject (toFile source) $ \cSource ->
        withGObject (toFile destination) $ \cDestination ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          cProgressCallback <- maybe (return nullFunPtr) marshalFileProgressCallback progressCallback
          propagateGError $ \cError -> do
            ret <- g_file_move cSource
                               cDestination
                               (cFromFlags flags)
                               cCancellable
                               cProgressCallback
                               nullPtr
                               cError
            freeHaskellFunPtr cProgressCallback
            return $ toBool ret
    where _ = {# call file_move #}

fileMakeDirectory :: FileClass file
                  => file
                  -> Maybe Cancellable
                  -> IO ()
fileMakeDirectory file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          propagateGError $ g_file_make_directory cFile cCancellable
          return ()
    where _ = {# call file_make_directory #}

fileMakeDirectoryWithParents :: FileClass file
                             => file
                             -> Maybe Cancellable
                             -> IO ()
fileMakeDirectoryWithParents file cancellable =
    withGObject (toFile file) $ \cFile ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          propagateGError $ g_file_make_directory_with_parents cFile cCancellable
          return ()
    where _ = {# call file_make_directory_with_parents #}

fileMakeSymbolicLink :: FileClass file
                     => file
                     -> String
                     -> Maybe Cancellable
                     -> IO ()
fileMakeSymbolicLink file symlinkValue cancellable =
    withGObject (toFile file) $ \cFile ->
        withUTFString symlinkValue $ \cSymlinkValue ->
        maybeWith withGObject cancellable $ \cCancellable -> do
          propagateGError $ g_file_make_symbolic_link cFile cSymlinkValue cCancellable
          return ()
    where _ = {# call file_make_symbolic_link #}