```module Algebras.Functor.Category where

import Prelude hiding (map, zip)
import qualified Prelude

--- functor
class Funct f where
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, map :: (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

-- especificando a relaçao para funçao
class (Relations f o m) => Function f o m | f -> o m where
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
dom f = src f
--cod f = tgt f
-- 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 = (retrieve pair i)

-- uma regra para dado um ponto no dominio, retornar o seu valor correspondente
retrieve :: (Eq a) => ([a], [b]) -> a -> b
retrieve (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

```