{-- TerraHS - Interface between TerraLib and Haskell

    (c) Sergio Costa (INPE) - Setembro, 2005

	This program is free software; you can redistribute it 
    and/or modify it under the terms of the GNU General 
    Public License 2.1 as published by the Free Software Foundation
    (http://www.opensource.org/licenses/gpl-license.php)
--}

-- | Module for handling terralib an haskell objects 
module TerraHS.Misc.Object
	(
	-- * The @Pointer@ class
	Pointer (..),
	
	-- * The @Convert@ class
	Convert (..),
	
	-- * The @Element@ class
	Element (..),
	
	-- * The @Size@ class
	Size (..),
	
	)
 	where


import Foreign
import qualified Foreign.Ptr (Ptr)

-- | The class @Pointer@ is a class for handling pointers to objects, ex: TePoint and TePointPtr
class Pointer a where
	-- |  create a pointer from haskell object 
	new:: a -> Prelude.IO (Foreign.Ptr.Ptr a)

	-- | create a haskell object from a pointer
	fromPointer :: (Foreign.Ptr.Ptr a) ->  Prelude.IO a
	
	-- | delete a pointer from memory
	delete :: (Foreign.Ptr.Ptr a) -> Prelude.IO ()
	delete l = error "not implemented"

-- | The class @Convert@ permit the converts from diferents objects
class Convert a b where
	-- | convert from a to b
	to :: a -> b
	-- | convert from b to a
	from :: b -> a	


class Element a b where
	getElement :: (Foreign.Ptr.Ptr a) -> Int32 -> Prelude.IO b

class Size a where
	size :: (Foreign.Ptr.Ptr a) -> Prelude.IO Int32