[htoolkit-cvs] port/src/Port ConfigKey.hs,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv31718/port/src/Port

Added Files:
	ConfigKey.hs 
Log Message:
Implementation for persistent configuration keys for both Windows and Linux.
Under Windows they are stored in Windows Registry and under Linux they are
stored in GConf configuration database


--- NEW FILE: ConfigKey.hs ---
{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------------------
{-| Module      :  ConfigKey
    Copyright   :  (c) Krasimir Angelov 2003
    License     :  BSD-style

    Maintainer  :  ka2...@ya...
    Stability   :  provisional
    Portability :  portable
-}
-----------------------------------------------------------------------------------------
module Graphics.UI.Port.ConfigKey
	( ConfigKey
	, setConfigKey, getConfigKey, getConfigKeyDef
	) where

import Foreign
import Foreign.C

-----------------------------------------------------------------------------------------
-- ConfigKey class definition
-----------------------------------------------------------------------------------------

class ConfigKey a where
  setConfigKey    :: String -> a -> IO ()
  getConfigKey    :: String -> IO a
  getConfigKeyDef :: String -> a -> IO a


-----------------------------------------------------------------------------------------
-- Class instance for String type
-----------------------------------------------------------------------------------------

instance ConfigKey String where
  setConfigKey name value =
    (withCString name  $ \cname ->
     withCString value $ \cvalue ->
       osSetConfigStringKey cname cvalue)
  
  getConfigKey name = getConfigKeyDef name ""
  
  getConfigKeyDef name defvalue =
    (withCString name $ \cname -> do
       ptr <- osGetConfigStringKey cname nullPtr
       (if ptr == nullPtr 
          then return defvalue
          else do
                value <- peekCString ptr
                free ptr
                return value))

foreign import ccall osGetConfigStringKey :: CString -> CString -> IO CString
foreign import ccall osSetConfigStringKey :: CString -> CString -> IO ()


-----------------------------------------------------------------------------------------
-- Class instance for Int type
-----------------------------------------------------------------------------------------

instance ConfigKey Int where
  setConfigKey name value =
    withCString name (\cname -> osSetConfigIntKey cname value)

  getConfigKey name = getConfigKeyDef name 0

  getConfigKeyDef name defvalue =
	withCString name (\cname -> osGetConfigIntKey cname defvalue)

foreign import ccall osGetConfigIntKey :: CString -> Int -> IO Int
foreign import ccall osSetConfigIntKey :: CString -> Int -> IO ()


-----------------------------------------------------------------------------------------
-- Class instance for Double type
-----------------------------------------------------------------------------------------

instance ConfigKey Double where
  setConfigKey name value =
    withCString name (\cname -> osSetConfigDoubleKey cname value)

  getConfigKey name = getConfigKeyDef name 0.0

  getConfigKeyDef name defvalue =
	withCString name (\cname -> osGetConfigDoubleKey cname defvalue)

foreign import ccall osGetConfigDoubleKey :: CString -> Double -> IO Double
foreign import ccall osSetConfigDoubleKey :: CString -> Double -> IO ()


-----------------------------------------------------------------------------------------
-- Class instance for Bool type
-----------------------------------------------------------------------------------------

instance ConfigKey Bool where
  setConfigKey name value =
    withCString name (\cname -> osSetConfigBoolKey cname value)

  getConfigKey name = getConfigKeyDef name False

  getConfigKeyDef name defvalue =
	withCString name (\cname -> osGetConfigBoolKey cname defvalue)

foreign import ccall osGetConfigBoolKey :: CString -> Bool -> IO Bool
foreign import ccall osSetConfigBoolKey :: CString -> Bool -> IO ()