{-- 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 TerraHS.TerraLib.TeGeoObject
	(
		-- * The @TeGeoObject@ type
		TeGeoObject (..),

		-- ** Operations on @TeGeoObject@ 
		loadGeoObjects,
		
	)
	 where

import Foreign.C.String

import TerraHS.Algebras.Spatial.Geometries
import TerraHS.Algebras.Spatial.Points
import TerraHS.Algebras.Base.Attribute
import TerraHS.Algebras.Spatial.Lines
import TerraHS.Algebras.Spatial.Polygons
import TerraHS.Algebras.Base.Ids

import TerraHS.TerraLib.TeGeometry

import TerraHS.Algebras.Spatial.GeoObjects

import TerraHS.Algebras.Spatial.GeoObjects


import TerraHS.Algebras.DB.Databases

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

import TerraHS.TerraLib.TeGeometry
import TerraHS.TerraLib.TePoint
import TerraHS.TerraLib.TeLine2D
import TerraHS.TerraLib.TeCell
import TerraHS.TerraLib.TeBox
import TerraHS.TerraLib.TePolygon
import TerraHS.TerraLib.TeDatabase
import TerraHS.TerraLib.TeSTInstance
import TerraHS.TerraLib.TeLayer
import TerraHS.TerraLib.TeTheme
import TerraHS.TerraLib.TeQuerier
import TerraHS.TerraLib.TeTable


data TeGeoObject = TeGeoObject ObjectId [Attribute] [TeGeometry] -- deriving (Show) -- falta implementar a parte

instance GeoObjects TeGeoObject ObjectId Attribute Value TeGeometry TePolygon TeLine2D TePoint Double where
	getId (TeGeoObject obid attrs geometries) = obid
	getAttributes (TeGeoObject obid attrs geometries) = attrs
	getGeometries (TeGeoObject obid attrs geometries) = geometries

instance Show TeGeoObject where
	show st = show (getId st) ++ " " ++ show ( [g] ) ++ " " ++ show (getAttributes st)
		where
		geos = getGeometries st
		geo = (head geos)
		g = formatG geo
			where
			formatG (GPt g) = (GPt g)
			formatG (GCl g) = (GCl g)
			formatG (GLn g) = (GLn (fl g))
				where
				fl (TeLine2D ps) = (TeLine2D [(head ps), (last ps)])
			formatG (GPg g) = (GPg (fp g))
				where
				fp (TePolygon ls) = (TePolygon [fl (head ls)])
				fl (TeLine2D ps) = (TeLine2D [(head ps), (last ps)])
		

instance Databases [TeGeoObject] TeDatabase TeTheme where
	retrieve db (TeTheme tn) = do
		theme <- loadTheme db tn
		query <- new (TeQuerierTheme theme True True)
		layer <- tetheme_layer theme
		st <- loadInstances query
		num <- numElemInstances query
		goSet <- getgeoobjects query layer 0 num 
		return goSet
		where
		getgeoobjects q layer i size = (nextInstance q) >>= (testInstance2geObject layer)>>= \geo -> 
			if i >= size then return [] else getgeoobjects q layer (i+1) size >>= \xs -> return  (geo : xs)
			
instance Databases [TeGeoObject] TeDatabase String where
	retrieve db ln = do
		layer <- loadLayer db ln
		query <- new (TeQuerier layer True True)
		st <- loadInstances query
		num <- numElemInstances query
		goSet <- getgeoobjects query layer 0 num 
		return goSet
		where
		getgeoobjects q layer i size = (nextInstance q) >>= (testInstance2geObject layer)>>= \geo -> 
			if i >= size then return [] else getgeoobjects q layer (i+1) size >>= \xs -> return  (geo : xs)
			
	store db name st1 = do
		layer <- new (TeLayer name db)
		let st = addObIds st1 0
		let attrs = map getAttributes st
		let props = map (map (\(Attr t) -> t)) attrs
		let fields = fst (unzip  (head props ))
		let values = map (snd . unzip ) props
		let strs = map ( (map toString) ) values
		saveTable layer (TeTable name fields strs )  
		let gs = map head (map (getGeometries ) st)
		if (isPoint (head gs)) then	do
			let ps = geo2Points gs
			addPoints layer (TePointSet ps) else do
				if (isLine (head gs)) then do
					let ls = geo2Lines gs
					addLines layer (TeLineSet ls) else do
						if (isPolygon (head gs)) then do
							let ps = geo2Polygons gs
							addPolygons layer (TePolygonSet ps) else do
								let cs = geo2Cells gs
								addCells layer (TeCellSet cs)
								
								
								
								
-------- gambiarra


takeNo               :: (a -> Bool) -> [a] -> [a]
takeNo p []          =  []
takeNo p (x:xs) 
            | (not (p x))       =  x : takeNo p xs
            | otherwise = (takeNo p xs)

            
setAtribute [] _ = []
setAtribute  ((TeGeoObject id _  geo):xs) (y:ys) = (TeGeoObject id y  geo ) : (setAtribute xs ys)    

apaga_id go = takeNo (\x->((getName x)) ==  "object_id_hs") (getAttributes go)

arruma_id gos = setAtribute gos (map apaga_id gos)

------------------------------------------------------------------------------------------ arrumar essa parte de cima
								
instance Databases [TeGeoObject] TeDatabase (String,TeProjection) where
			
	store db (name, prj) st1 = do
		prj <- new prj
		layer <- new (TeLayer name db)
		telayer_setprojection layer prj
		let st = addObIds (arruma_id st1) 0
		let attrs = map getAttributes st
		let props = map (map (\(Attr t) -> t)) attrs
		let fields = fst (unzip  (head props ))
		let values = map (snd . unzip ) props
		let strs = map ( (map toString) ) values
		saveTable layer (TeTable name fields strs )  
		let gs = map head (map (getGeometries ) st)
		if (isPoint (head gs)) then	do
			let ps = geo2Points gs
			addPoints layer (TePointSet ps) else do
				if (isLine (head gs)) then do
					let ls = geo2Lines gs
					addLines layer (TeLineSet ls) else do
						if (isPolygon (head gs)) then do
							let ps = geo2Polygons gs
							addPolygons layer (TePolygonSet ps) else do
								let cs = geo2Cells gs
								addCells layer (TeCellSet cs)

addObIds :: [TeGeoObject] -> Int -> [TeGeoObject]			
addObIds go i = addObIds' go i object_id_hs					
	where
	object_id_hs =( (filter (=="object_id_hs") ( fst (unzip  (head (map (map (\(Attr t) -> t)) ( map getAttributes go)) )) )) /= [])
	addObIds' :: [TeGeoObject] -> Int -> Bool -> [TeGeoObject]
	addObIds' go _ True = go
	addObIds' [] _ _ = [] 
	addObIds' ((TeGeoObject (ObjectId id)  atts geos ):os) i _=  (TeGeoObject (ObjectId (show i))  (((Attr ("object_id_hs", (StValue (show i) ) ) )  ) : atts ) geos) : (addObIds' os (i+1) False)
	--addObIds' ((TeGeoObject (ObjectId id)  atts geos ):os) i _=  (TeGeoObject (ObjectId id)  (((Attr ("object_id_hs", (StValue id ) ) )  ) : atts ) geos) : (addObIds' os (i+1) False)		
	
loadGeoObjects db name = ( (retrieve db name)::(IO [TeGeoObject]) )
				
testInstance2geObject :: TeLayerPtr -> TeSTInstancePtr ->  IO TeGeoObject
testInstance2geObject layer st  = objectId st >>= \obid -> getProperties st >>= \attrs -> getGeometry st layer >>= \geo -> return (TeGeoObject (ObjectId obid) (map Attr attrs) geo)