module TerraHS.Algebras.Base.Category where

import Prelude hiding (map, zip)
import qualified Prelude

--- functor
class Funct f where
    -- add a gfold
    unlift :: f a -> a
    ($*$) :: f (a->b) -> f a -> f b     -- this is ap in monad utility, used infix as `ap`
    lift0 :: a -> f a
    --
    lift1:: (a->b) -> f a -> f b      -- map, exactly liftM
    --map = lift1
   
    lift2 :: (a->b->c) -> f a -> f b -> f c -- zipWith, liftM2
    --zip :: f a -> f b -> f (a,b)
    --zip = lift2 (\a b -> (a,b))
    lift3 :: (a->b->c->d) -> f a -> f b -> f c -> f d   -- for convolution (3 x 3 kernel)
    lift4 :: (a->b->c->d->e) -> f a -> f b -> f c -> f d -> f e -- for incircle test
    
    


 
instance Funct [] where
    unlift [a] = a
    lift0 a = [a]
    lift1 = Prelude.map
    lift2 = Prelude.zipWith
    lift3 f [] _ _ = []
    lift3 f _ [] _ = []
    lift3 f _ _ [] = []
    lift3 f (a:as) (b:bs) (c:cs) = (f a b c) : (lift3 f as bs cs)


{--
A relation on morphism e pares de objetos, called typing of the morphism
By default, the relation is deonted f: A -> B, for morphism f and objects A, B
In this case we also say that A -> B is the type of f, and that f is a morphism
form A to B. In view of the axioms below we may define the source an target

by

src f = A and tgt f = B whenever f: A -> B
--}

-- definindo as operaçoes para uma relaçao (r) entre objetos (o) e m morfismo (m)
class Relations r o m  | r -> o m where
	tgt :: r a b  	->  o b
	src :: r a b  	->  o a 		-- retorna o dominio	
	-- dado uma categoria de a e b, existe um mapeamento de a para b
	arrow :: r a b 	-> m a b --- ( a -> b ) 

-- uma relaação em categoria é definida por uma tripla composta por um morfismo entre dois objeto (a e b)
-- e um par de objetos (o a e o b) 
type Relation o m a b = ( m a b , o a, o b   ) -- um tipo abstrato

-- axiomas 

instance Relations Fun [] (->) where
	src 	(Fun ( f, a, b) ) = a
	tgt		(Fun ( f, a, b) ) = b
	arrow 	(Fun ( f, a, b)	) = f

	
class (Relations f o m) => Function f o m | f -> o m where
	fold1 ::  (b -> b -> b) ->(f a b)-> b
	dom :: f a b -> [a]
	cod :: f a b -> [b]
	fun :: f a b -> (a -> b)

	
newtype Fun a b =  Fun (Relation ([]) (->) a b)

		
instance Function Fun ([]) (->) where
	fold1 f fi     =  foldr1 f (cod fi)
	dom f = src f	
	--cod f = tgt f
	-- o codominio foi reimplementado
	-- equivale a aplicao lift1 do morfismo de f no seu dominio
	cod f = lift1 (fun f) (dom f) 
	fun f = arrow f

		
	
new_fun f domain = Fun (f , domain, [])	

--concat_cod f1 f2 = 

new_fun1 domain codomain = Fun (f1 , domain, [])	
	where
	pair = (domain, codomain)
	f1 i = (retrieve1 pair i)


-- uma regra para dado um ponto no dominio, retornar o seu valor correspondente
retrieve1 :: (Eq a) => ([a], [b]) -> a -> b
retrieve1 (obs, ids) id1 =  retrieve' (filter ((== id1) . fst ) (Prelude.zip obs ids) )
	where
	retrieve' (xs) = snd (head xs)




--fold1    :: (Function f o m) => (b -> b -> b) ->(f a b)-> b
--fold1 f fi     =  foldr1 f (cod fi)


eval :: (Eq a) => Fun a b -> a -> Maybe b
eval f o 
	| (( elem o (dom f) ) == True ) = Just ((fun f) o)	
	| otherwise = Nothing

eval' :: (Eq a) => (Maybe (Fun a b)) -> a -> Maybe b
eval' Nothing _ = Nothing
eval' (Just f) o 
	| (( elem o (dom f) ) == True ) = Just ((fun f) o)	
	| otherwise = Nothing