{-# 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