module  Algebras.Functor.GeoModel where

	
import TerraHS.TerraLib
import TerraHS.TerraLib.TeSTInstance
import Algebras.Base

import Algebras.Base.Model
import TerraHS.Misc
import Algebras.Base.GeoObjects

import Algebras.Functor.Category
import TerraHS.TerraLib.TeDatabase


type SpatialValue = (Fun TeGeometry Value)

type Layer = Fun String SpatialValue



instance Funct (Fun TeGeometry) where
	lift1  g ( Fun ( f, e, d ) )  =  ( Fun ( (g.f) , e , [] ) )
	lift2 f f1 f2 = ( Fun ( nf, (dom f1), [] ) )
   		where
		nf i =  (f  ( (arrow f1) i)  ((arrow f2) i )  ) 
		
		
instance ModelConvert Layer where
	

	toGeoObjects  f = toGeoObjects' geos vals ids
		where
		geos = (dom  (head (cod f)))
		vals = (lift1 (\x -> (lift1 (\at -> (Attr ( at, (fun (fun f at)) x ) )) (dom f) )) (dom (head (cod f))))
		ids = lift1 (ObjectId . show) ([0..((length geos)-1)])
		toGeoObjects' [] _ _ = []
		toGeoObjects' (g:gs) (at:ats) (i:is) = (TeGeoObject i ( ([ (Attr ("object_id_hs", (StValue (id2string i) ) ) ) ] ) ++ at)  [g]  ) : (toGeoObjects' gs ats is)

	
	fromGeoObjects  os = (new_fun (toFun' os) (attnames) )
		where
		attnames = getAttributesName (head os)
		toFun' os attname = (new_fun (retrieve1 m) (lift1 fst m) )
			where
			m = ( lift1 (toPairRegValue attname) os ) 
			
instance ModelPersistence Layer where 
	
----------------------------
------- auxiliary functions
---------------------------
			
concatLayerFun :: Layer -> Layer -> Layer
concatLayerFun f1 f2 = new_fun1 ((dom f1) ++ (dom f2) ) ((cod f1) ++ (cod f2) ) 

toLayer :: String -> SpatialValue -> Layer
toLayer  attrname f = new_fun1 [attrname] [f]
			
-- transforma um dado geo-objeto em uma tupla região valor
toPairRegValue ::  String -> TeGeoObject -> (TeGeometry , Value)
toPairRegValue  str teobs =   ( (head (getGeometries teobs)), ( getValuebyName (getAttributes teobs) str ) )

-- função que retorna um valor a partir da tupla de geometria e valor
retrieve1 :: [(TeGeometry, Value)] -> TeGeometry -> Value
retrieve1 obs o = snd (head (filter (\par -> ((fst par ) == o ) ) obs) )


-- função que retorna uma lista de nomes de atributos de um tegeoobject
getAttributesName :: TeGeoObject -> [String]
getAttributesName geo = lift1 getName attlist
	where
	attlist :: [Attribute]
	attlist = (getAttributes geo)