{-- 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 - -} 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.Misc.Generic import TerraHS.Misc.Object 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 addAttrList attlist attrs 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) 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_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 ()