{-# LINE 1 "System/Glib/StoreValue.hsc" #-}
-- -*-haskell-*-
{-# LINE 2 "System/Glib/StoreValue.hsc" #-}
--  GIMP Toolkit (GTK) StoreValue GenericValue
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Copyright (c) 1999..2002 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.
--
-- TODO: this module is deprecated and should be removed. The GenericValue
-- type is currently exposed to users and it should not be.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
module System.Glib.StoreValue (
  TMType(..),
  GenericValue(..),
  valueSetGenericValue,
  valueGetGenericValue,
  ) where

import Control.Monad	(liftM)
import Data.Text (Text)

import Control.Exception  (throw, AssertionFailed(..))


{-# LINE 41 "System/Glib/StoreValue.hsc" #-}

import System.Glib.FFI
import System.Glib.GValue	(GValue, valueInit, valueGetType)
import System.Glib.GValueTypes
import qualified System.Glib.GTypeConstants as GType
import System.Glib.Types	(GObject)

-- | A union with information about the currently stored type.
--
-- * Internally used by "Graphics.UI.Gtk.TreeList.TreeModel".
--
data GenericValue = GVuint    Word
		  | GVint     Int
--		  | GVuchar   #{type guchar}
--		  | GVchar    #{type gchar}
		  | GVboolean Bool
		  | GVenum    Int
		  | GVflags   Int
--		  | GVpointer (Ptr ())
		  | GVfloat   Float
		  | GVdouble  Double
		  | GVstring  (Maybe Text)
		  | GVobject  GObject
--		  | GVboxed   (Ptr ())

-- This is an enumeration of all GTypes that can be used in a TreeModel.
--
data TMType = TMinvalid
	    | TMuint
	    | TMint
--	    | TMuchar
--	    | TMchar
	    | TMboolean
	    | TMenum
	    | TMflags
--	    | TMpointer
	    | TMfloat
	    | TMdouble
	    | TMstring
	    | TMobject
--	    | TMboxed

instance Enum TMType where
  fromEnum TMinvalid = 0
{-# LINE 85 "System/Glib/StoreValue.hsc" #-}
  fromEnum TMuint    = 28
{-# LINE 86 "System/Glib/StoreValue.hsc" #-}
  fromEnum TMint     = 24
{-# LINE 87 "System/Glib/StoreValue.hsc" #-}
--  fromEnum TMuchar   = #const G_TYPE_UCHAR
--  fromEnum TMchar    = #const G_TYPE_CHAR
  fromEnum TMboolean = 20
{-# LINE 90 "System/Glib/StoreValue.hsc" #-}
  fromEnum TMenum    = 48
{-# LINE 91 "System/Glib/StoreValue.hsc" #-}
  fromEnum TMflags   = 52
{-# LINE 92 "System/Glib/StoreValue.hsc" #-}
--  fromEnum TMpointer = #const G_TYPE_POINTER
  fromEnum TMfloat   = 56
{-# LINE 94 "System/Glib/StoreValue.hsc" #-}
  fromEnum TMdouble  = 60
{-# LINE 95 "System/Glib/StoreValue.hsc" #-}
  fromEnum TMstring  = 64
{-# LINE 96 "System/Glib/StoreValue.hsc" #-}
  fromEnum TMobject  = 80
{-# LINE 97 "System/Glib/StoreValue.hsc" #-}
--  fromEnum TMboxed   = #const G_TYPE_BOXED
  toEnum 0 = TMinvalid
{-# LINE 99 "System/Glib/StoreValue.hsc" #-}
  toEnum 28    = TMuint
{-# LINE 100 "System/Glib/StoreValue.hsc" #-}
  toEnum 24	 = TMint
{-# LINE 101 "System/Glib/StoreValue.hsc" #-}
--  toEnum #{const G_TYPE_UCHAR} = TMuchar
--  toEnum #{const G_TYPE_CHAR}	 = TMchar
  toEnum 20 = TMboolean
{-# LINE 104 "System/Glib/StoreValue.hsc" #-}
  toEnum 48	 = TMenum
{-# LINE 105 "System/Glib/StoreValue.hsc" #-}
  toEnum 52	 = TMflags
{-# LINE 106 "System/Glib/StoreValue.hsc" #-}
--  toEnum #{const G_TYPE_POINTER} = TMpointer
  toEnum 56	 = TMfloat
{-# LINE 108 "System/Glib/StoreValue.hsc" #-}
  toEnum 60	 = TMdouble
{-# LINE 109 "System/Glib/StoreValue.hsc" #-}
  toEnum 64	 = TMstring
{-# LINE 110 "System/Glib/StoreValue.hsc" #-}
  toEnum 80	 = TMobject
{-# LINE 111 "System/Glib/StoreValue.hsc" #-}
--  toEnum #{const G_TYPE_BOXED}	 = TMboxed
  toEnum _			 =
    error "StoreValue.toEnum(TMType): no dynamic types allowed."

valueSetGenericValue :: GValue -> GenericValue -> IO ()
valueSetGenericValue gvalue (GVuint x)    = do valueInit gvalue GType.uint
                                               valueSetUInt gvalue x
valueSetGenericValue gvalue (GVint x)     = do valueInit gvalue GType.int
                                               valueSetInt  gvalue x
--valueSetGenericValue gvalue (GVuchar x)   = valueSetUChar   gvalue x
--valueSetGenericValue gvalue (GVchar x)    = valueSetChar    gvalue x
valueSetGenericValue gvalue (GVboolean x) = do valueInit gvalue GType.bool
                                               valueSetBool    gvalue x
valueSetGenericValue gvalue (GVenum x)    = do valueInit gvalue GType.enum
                                               valueSetUInt    gvalue (fromIntegral x)
valueSetGenericValue gvalue (GVflags x)   = do valueInit gvalue GType.flags
                                               valueSetUInt    gvalue (fromIntegral x)
--valueSetGenericValue gvalue (GVpointer x) = valueSetPointer gvalue x
valueSetGenericValue gvalue (GVfloat x)   = do valueInit gvalue GType.float
                                               valueSetFloat   gvalue x
valueSetGenericValue gvalue (GVdouble x)  = do valueInit gvalue GType.double
                                               valueSetDouble  gvalue x
valueSetGenericValue gvalue (GVstring x)  = do valueInit gvalue GType.string
                                               valueSetMaybeString  gvalue x
valueSetGenericValue gvalue (GVobject x)  = do valueInit gvalue GType.object
                                               valueSetGObject gvalue x
--valueSetGenericValue gvalue (GVboxed x)   = valueSetPointer gvalue x

valueGetGenericValue :: GValue -> IO GenericValue
valueGetGenericValue gvalue = do
  gtype <- valueGetType gvalue
  case (toEnum . fromIntegral) gtype of
    TMinvalid	-> throw $ AssertionFailed
      "StoreValue.valueGetGenericValue: invalid or unavailable value."
    TMuint    -> liftM GVuint			  $ valueGetUInt    gvalue
    TMint	-> liftM GVint	                  $ valueGetInt	    gvalue
--    TMuchar	-> liftM GVuchar		  $ valueGetUChar   gvalue
--    TMchar	-> liftM GVchar			  $ valueGetChar    gvalue
    TMboolean	-> liftM GVboolean		  $ valueGetBool    gvalue
    TMenum	-> liftM (GVenum . fromIntegral)  $ valueGetUInt    gvalue
    TMflags	-> liftM (GVflags . fromIntegral) $ valueGetUInt    gvalue
--    TMpointer	-> liftM GVpointer		  $ valueGetPointer gvalue
    TMfloat	-> liftM GVfloat		  $ valueGetFloat   gvalue
    TMdouble	-> liftM GVdouble		  $ valueGetDouble  gvalue
    TMstring	-> liftM GVstring		  $ valueGetMaybeString  gvalue
    TMobject	-> liftM GVobject		  $ valueGetGObject gvalue
--    TMboxed   -> liftM GVpointer		  $ valueGetPointer gvalue