x.hs

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}

import Data.Either
import Control.Monad

data Error = Error

type (a ~> b) c = c a b

class Category (c :: k -> k -> *) where
  id :: (a ~> a) c
  (.) :: (y ~> z) c -> (x ~> y) c -> (x ~> z) c
  
type Hask = (->)
 
instance Category Hask where
  id x = x
  (f . g) x = f (g x)
  
class (Category c, Category d) => Fuctor c d t where
  fmap :: c a b -> d (t a) (t b)    
  
    
newtype Id a = Id a
        
newtype Hask' m a b = Hask' (a -> m b)

instance (Monad m) => Category (Hask' m) where
  id = Hask' return
  (Hask' f) . (Hask' g) = Hask' $ (g >=> f)
    
instance (Monad m) => Fuctor Hask (Hask' m) Id where
    fmap f = Hask' (\(Id x) -> return $ Id (f x))

instance (Monad m) => Fuctor (Hask' m) Hask m where
    fmap (Hask' f) x = x >>= f
    
type HaskExp = Hask' (Either Error)