{-- 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 the Attributes
module TerraHS.Algebras.Base.Attribute
	(
			-- * The @Attribute@ type 
			Attribute (..),
			
			-- * The @Attributes@ class
			Attributes (..), 
			
			-- * The @Values@ class
			Values (..),
			
			-- ** Operations on @Value@ 
			toString,
			
			-- * The @Values@ class
			Values (..),
			
			-- * The @Value@ type 
			Value (..),
			
			Property,

			getValuebyName


	)
	 where

--import TerraHS.TerraLib.TeSTInstance

class (Values v) => Attributes a v | a -> v where
	getName :: a -> String
	getValue :: a -> v

type Property = (String, Value) -- (name,value)

data Attribute = Attr Property deriving (Show) -- (name,value)	



data Value  
	= StValue String  
	| DbValue Double  
	| InValue Int
	| Undefined
	deriving (Eq, Show)
	
instance Attributes Attribute Value where	
	getName ( Attr (name, val) ) = name
	getValue ( Attr (name, val) ) = val			

		
getValuebyName :: [Attribute] -> String -> Value
getValuebyName [] _ = error "attribute not found"	
getValuebyName (x:xs) str
	|((getName x) == str ) = getValue x
	| otherwise = getValuebyName xs str

--- fazer isso com funtores
instance Num Value where
	(+) (DbValue v1) (DbValue v2) = ( DbValue (v1 + v2) )
	(+) (InValue v1) (InValue v2) = ( InValue (v1 + v2) )
	(+) (StValue v1) (StValue v2) = ( StValue (v1 ++ v2) )
	(+) Undefined _ = Undefined
	(+) _ Undefined = Undefined
	
	(-) (DbValue v1) (DbValue v2) = ( DbValue (v1 - v2) )
	(-) (InValue v1) (InValue v2) = ( InValue (v1 - v2) )
	(-) Undefined _ = Undefined
	(-) _ Undefined = Undefined
	
	(*) (DbValue v1) (DbValue v2) = ( DbValue (v1 - v2) )
	(*) (InValue v1) (InValue v2) = ( InValue (v1 - v2) )
	(*) Undefined _ = Undefined
	(*) _ Undefined = Undefined
	
-- implementation
class Values a where
	toString :: a -> String
	

instance Values Value where
	toString (StValue v) = v
	toString (DbValue v) = (show v)
	toString (DbValue v) = (show v)
	toString (InValue v) = (show v)