{-- 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)
--}
 {- | A module for supporting a TeTableTerraLib class

 Instances of this classes represent non-spatial tables, or tables
that donīt have a spatial data as one of its columns.
The class stores the table schema and it also can store rows of data.

More information - <http://www.terralib.org> -}

module TerraHS.TerraLib.TeTable 
	(
	
	-- * The @TeTable@ type
	TeTable (..),
	
	-- * The @TeTablePtr@ type
	TeTablePtr,
	
	-- ** Operations on @TeTable@ 
	addValues
	)
	where

import Foreign
import Foreign.C
import Foreign.C.String
import qualified System.IO.Unsafe (unsafePerformIO)
import qualified Foreign.Ptr (Ptr)
import qualified Data.Int (Int32)


import TerraHS.Algebras.Base.Object
import TerraHS.Misc.GenericFunctions

--- tenho que mudar a estrutura da tabela
data TeTable = TeTable String Fields Data deriving (Show)

-- | The type @TeTablePtr@ is a pointer to @TeTable@
type TeTablePtr = Foreign.Ptr.Ptr TeTable

type Data =  [[String]]
type Fields = [String]

-- | The type @TeTableRow@ is a list of strings
data TeTableRow = TeTableRow [String] 

-- | The type @TeTableRowPtr@ is a pointer to @TeTableRow@
type TeTableRowPtr = Foreign.Ptr.Ptr TeTableRow

data TeAttributeList = TeAttributeList deriving (Show)
type TeAttributeListPtr = Foreign.Ptr.Ptr TeAttributeList



instance Pointer TeTable where

	fromPointer table = do
		let htable = tetable_tetable2list_l table 0 0
		let hfields = tetable_getFields table 0
		return (TeTable "table" hfields htable)

	
	new ((TeTable name attrs values)) = do
		attlist <- teattributelist_new
		let attr_v = zip attrs (head values)
		--addAttrList attlist attrs
		addAttrList1 attlist attr_v
		tbname <- newCString name
		tetable_new2 tbname attlist
		


addRow :: [String] -> TeTableRowPtr -> IO ()
addRow [] _ = return ()
addRow (x:xs) row = do
	cstr <- newCString x
	tetablerow_add row cstr 
	addRow xs row
	
addValues :: [[String]] -> TeTablePtr -> IO ()
addValues [] _ = return ()
addValues (x:xs) table  = do 
	row <- tetablerow_new
	addRow x row
	tetable_addRow table row
	addValues xs table
		
addAttrList :: TeAttributeListPtr -> [String] -> IO ()
addAttrList attrlist [] = return ()
addAttrList attrlist (x:xs) =  newCString x >>= addAttributebyName attrlist >> (addAttrList attrlist xs)

addAttrList1 :: TeAttributeListPtr -> [(String,String)] -> IO ()
addAttrList1 attrlist [] = return ()
addAttrList1 attrlist (x:xs) =  newCString (fst x) >>= \name ->  newCString (snd x) >>= \value -> addAttributebyName1 attrlist name value >> (addAttrList1 attrlist xs)
	
tetable_tetable2list :: TeTablePtr -> Int32 -> Int32 -> [[String]]
tetable_tetable2list t l c
	| (c >= nc) || (l >= nl) = [[]]
	|otherwise = (tetable_tetable2list_c t l c) : (tetable_tetable2list t (l+1) c)
	where
	nl = System.IO.Unsafe.unsafePerformIO (tetable_numLines t)
	nc = System.IO.Unsafe.unsafePerformIO (tetable_numColluns t)

	
tetable_tetable2list_l :: TeTablePtr -> Int32 -> Int32 -> [[String]]
tetable_tetable2list_l t l c
	| (c >= nc) || (l >= nl) = [[]]
	|otherwise = (tetable_tetable2list_c t l c) : (tetable_tetable2list_l t (l+1) c)
	where
	nl = System.IO.Unsafe.unsafePerformIO (tetable_numLines t)
	nc = System.IO.Unsafe.unsafePerformIO (tetable_numColluns t)

tetable_tetable2list_c :: TeTablePtr -> Int32 -> Int32 -> [String]
tetable_tetable2list_c t l c
	| (c >= nc) || (l >= nl)   = []
	|otherwise = (tetable_getValue t l c) : (tetable_tetable2list_c t l (c+1))
	where
	nl = System.IO.Unsafe.unsafePerformIO (tetable_numLines t)
	nc = System.IO.Unsafe.unsafePerformIO (tetable_numColluns t)

tetable_getFields :: TeTablePtr -> Int32 -> [String]
tetable_getFields t i
	|i >= nc = []
	|otherwise = (tetable_getFieldName t i):(tetable_getFields t (i+1))
	where
	nc = System.IO.Unsafe.unsafePerformIO (tetable_numColluns t)
		
tetable_getFieldName :: TeTablePtr -> Int32 -> String
tetable_getFieldName table i = s
	where
	cs = System.IO.Unsafe.unsafePerformIO (h_tetable_getFieldName table i)
	s  = System.IO.Unsafe.unsafePerformIO (peekCString cs)
	
tetable_getValue :: TeTablePtr -> Int32 -> Int32 -> String
tetable_getValue table i j = s
	where
	cs = System.IO.Unsafe.unsafePerformIO (h_tetable_getValue table i j)
	s  = System.IO.Unsafe.unsafePerformIO (peekCString cs)

	
	
	
foreign import stdcall unsafe "c_tetable_getFieldName" h_tetable_getFieldName :: TeTablePtr -> Int32 -> Prelude.IO CString
foreign import stdcall unsafe "c_tetable_new" tetable_new :: Prelude.IO TeTablePtr
foreign import stdcall unsafe "c_tetable_getValue" h_tetable_getValue :: TeTablePtr -> Int32 -> Int32 -> Prelude.IO CString
foreign import stdcall unsafe "c_tetable_numLines" tetable_numLines :: TeTablePtr -> Prelude.IO Int32
foreign import stdcall unsafe "c_tetable_numColluns" tetable_numColluns :: TeTablePtr -> Prelude.IO Int32
foreign import stdcall unsafe "c_tetable_new2" tetable_new2 :: CString -> TeAttributeListPtr -> Prelude.IO TeTablePtr
foreign import stdcall unsafe "c_addAttributebyName" addAttributebyName ::  TeAttributeListPtr -> CString -> Prelude.IO TeTablePtr
foreign import stdcall unsafe "c_addAttributebyName1" addAttributebyName1 ::  TeAttributeListPtr -> CString -> CString ->  Prelude.IO TeTablePtr
foreign import stdcall unsafe "c_teattributelist_new" teattributelist_new ::  Prelude.IO TeAttributeListPtr
foreign import stdcall unsafe "c_tetable_addRow" tetable_addRow :: TeTablePtr -> TeTableRowPtr -> Prelude.IO ()
foreign import stdcall unsafe "c_tetablerow_new" tetablerow_new ::  Prelude.IO TeTableRowPtr
foreign import stdcall unsafe "c_tetablerow_add" tetablerow_add :: TeTableRowPtr -> CString -> Prelude.IO ()