{-# LINE 1 "System/Glib/StoreValue.hsc" #-}
-- -*-haskell-*-
--  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(..))



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 :: TMType -> Int
fromEnum TMType
TMinvalid = Int
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 TMType
TMboolean = Int
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 TMType
TMfloat   = Int
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 :: Int -> TMType
toEnum Int
0 = TMType
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 Int
20 = TMType
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 Int
56   = TMType
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 Int
_                       =
    [Char] -> TMType
forall a. HasCallStack => [Char] -> a
error [Char]
"StoreValue.toEnum(TMType): no dynamic types allowed."

valueSetGenericValue :: GValue -> GenericValue -> IO ()
valueSetGenericValue :: GValue -> GenericValue -> IO ()
valueSetGenericValue GValue
gvalue (GVuint Word
x)    = do GValue -> GType -> IO ()
valueInit GValue
gvalue GType
GType.uint
                                               GValue -> Word -> IO ()
valueSetUInt GValue
gvalue Word
x
valueSetGenericValue GValue
gvalue (GVint Int
x)     = do GValue -> GType -> IO ()
valueInit GValue
gvalue GType
GType.int
                                               GValue -> Int -> IO ()
valueSetInt  GValue
gvalue Int
x
--valueSetGenericValue gvalue (GVuchar x)   = valueSetUChar   gvalue x
--valueSetGenericValue gvalue (GVchar x)    = valueSetChar    gvalue x
valueSetGenericValue GValue
gvalue (GVboolean Bool
x) = do GValue -> GType -> IO ()
valueInit GValue
gvalue GType
GType.bool
                                               GValue -> Bool -> IO ()
valueSetBool    GValue
gvalue Bool
x
valueSetGenericValue GValue
gvalue (GVenum Int
x)    = do GValue -> GType -> IO ()
valueInit GValue
gvalue GType
GType.enum
                                               GValue -> Word -> IO ()
valueSetUInt    GValue
gvalue (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
valueSetGenericValue GValue
gvalue (GVflags Int
x)   = do GValue -> GType -> IO ()
valueInit GValue
gvalue GType
GType.flags
                                               GValue -> Word -> IO ()
valueSetUInt    GValue
gvalue (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
--valueSetGenericValue gvalue (GVpointer x) = valueSetPointer gvalue x
valueSetGenericValue GValue
gvalue (GVfloat Float
x)   = do GValue -> GType -> IO ()
valueInit GValue
gvalue GType
GType.float
                                               GValue -> Float -> IO ()
valueSetFloat   GValue
gvalue Float
x
valueSetGenericValue GValue
gvalue (GVdouble Double
x)  = do GValue -> GType -> IO ()
valueInit GValue
gvalue GType
GType.double
                                               GValue -> Double -> IO ()
valueSetDouble  GValue
gvalue Double
x
valueSetGenericValue GValue
gvalue (GVstring Maybe Text
x)  = do GValue -> GType -> IO ()
valueInit GValue
gvalue GType
GType.string
                                               GValue -> Maybe Text -> IO ()
forall string. GlibString string => GValue -> Maybe string -> IO ()
valueSetMaybeString  GValue
gvalue Maybe Text
x
valueSetGenericValue GValue
gvalue (GVobject GObject
x)  = do GValue -> GType -> IO ()
valueInit GValue
gvalue GType
GType.object
                                               GValue -> GObject -> IO ()
forall gobj. GObjectClass gobj => GValue -> gobj -> IO ()
valueSetGObject GValue
gvalue GObject
x
--valueSetGenericValue gvalue (GVboxed x)   = valueSetPointer gvalue x

valueGetGenericValue :: GValue -> IO GenericValue
valueGetGenericValue :: GValue -> IO GenericValue
valueGetGenericValue GValue
gvalue = do
  GType
gtype <- GValue -> IO GType
valueGetType GValue
gvalue
  case (Int -> TMType
forall a. Enum a => Int -> a
toEnum (Int -> TMType) -> (GType -> Int) -> GType -> TMType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GType -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) GType
gtype of
    TMType
TMinvalid   -> AssertionFailed -> IO GenericValue
forall a e. Exception e => e -> a
throw (AssertionFailed -> IO GenericValue)
-> AssertionFailed -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ [Char] -> AssertionFailed
AssertionFailed
      [Char]
"StoreValue.valueGetGenericValue: invalid or unavailable value."
    TMType
TMuint    -> (Word -> GenericValue) -> IO Word -> IO GenericValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word -> GenericValue
GVuint                     (IO Word -> IO GenericValue) -> IO Word -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ GValue -> IO Word
valueGetUInt    GValue
gvalue
    TMType
TMint       -> (Int -> GenericValue) -> IO Int -> IO GenericValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int -> GenericValue
GVint                    (IO Int -> IO GenericValue) -> IO Int -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ GValue -> IO Int
valueGetInt     GValue
gvalue
--    TMuchar   -> liftM GVuchar                  $ valueGetUChar   gvalue
--    TMchar    -> liftM GVchar                   $ valueGetChar    gvalue
    TMType
TMboolean   -> (Bool -> GenericValue) -> IO Bool -> IO GenericValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> GenericValue
GVboolean                (IO Bool -> IO GenericValue) -> IO Bool -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ GValue -> IO Bool
valueGetBool    GValue
gvalue
    TMType
TMenum      -> (Word -> GenericValue) -> IO Word -> IO GenericValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> GenericValue
GVenum (Int -> GenericValue) -> (Word -> Int) -> Word -> GenericValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)  (IO Word -> IO GenericValue) -> IO Word -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ GValue -> IO Word
valueGetUInt    GValue
gvalue
    TMType
TMflags     -> (Word -> GenericValue) -> IO Word -> IO GenericValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> GenericValue
GVflags (Int -> GenericValue) -> (Word -> Int) -> Word -> GenericValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO Word -> IO GenericValue) -> IO Word -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ GValue -> IO Word
valueGetUInt    GValue
gvalue
--    TMpointer -> liftM GVpointer                $ valueGetPointer gvalue
    TMType
TMfloat     -> (Float -> GenericValue) -> IO Float -> IO GenericValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Float -> GenericValue
GVfloat                  (IO Float -> IO GenericValue) -> IO Float -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ GValue -> IO Float
valueGetFloat   GValue
gvalue
    TMType
TMdouble    -> (Double -> GenericValue) -> IO Double -> IO GenericValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Double -> GenericValue
GVdouble                 (IO Double -> IO GenericValue) -> IO Double -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ GValue -> IO Double
valueGetDouble  GValue
gvalue
    TMType
TMstring    -> (Maybe Text -> GenericValue) -> IO (Maybe Text) -> IO GenericValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe Text -> GenericValue
GVstring                 (IO (Maybe Text) -> IO GenericValue)
-> IO (Maybe Text) -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ GValue -> IO (Maybe Text)
forall string. GlibString string => GValue -> IO (Maybe string)
valueGetMaybeString  GValue
gvalue
    TMType
TMobject    -> (GObject -> GenericValue) -> IO GObject -> IO GenericValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM GObject -> GenericValue
GVobject                 (IO GObject -> IO GenericValue) -> IO GObject -> IO GenericValue
forall a b. (a -> b) -> a -> b
$ GValue -> IO GObject
forall gobj. GObjectClass gobj => GValue -> IO gobj
valueGetGObject GValue
gvalue
--    TMboxed   -> liftM GVpointer                $ valueGetPointer gvalue