{-# OPTIONS_GHC -XTypeFamilies -fglasgow-exts -XNoImplicitPrelude -fenable-rewrite-rules -XTemplateHaskell -XFlexibleInstances -XCPP #-}

module Bug where

import Prelude hiding (id,(.),Functor,fmap)

-- | The typeclass of objects of a category
-- see "Control.RMonad" in the @rmonad@ package for the constraints trick
class (Category cat) => Ob cat a where
    type Constraints cat a
    constraints :: a -> Constraints cat a

-- Convenience definitions
#define ob2(cat,a,b) Ob cat a, Ob cat b
#define ob3(cat,a,b,c) Ob cat a, Ob cat b, Ob cat c
#define ob4(cat,a,b,c,d) Ob cat a, Ob cat b, Ob cat c, Ob cat d


-- | The object part of a functor. In contrast to the standard library, here a functor is not of kind * -> *. It is just a token to disambiguate which functor should be applied when there is more than one functor from a cat to another cat.
class ( Functor f
      , Ob (FDom f) a
      , Ob (FCod f) (FMap f a)) 

    => Defined (f :: *) (a :: *) where
        type FMap f a :: *

class Functor (f :: *) where
    type FDom f :: * -> * -> * -- ^ Domain of the functor
    type FCod f :: * -> * -> * -- ^ Codomain of the functor
    fmap :: ( Defined f a
            , Defined f b
            , ob2( (FCod f) , (FMap f a) , (FMap f b))
            )

                       => f -- ^ Functor token
                           -> (FDom f a b) -- ^ Input morphism
                           -> (FCod f (FMap f a) (FMap f b)) -- ^ Output morphism



-- | Essentially, we encode a category as its Hom operator
class Category cat where
    id :: (Ob cat a) => cat a a

    compose0 :: (ob3(cat, a, b, c)) 

                   => cat b c -> cat a b -> cat a c



-- this addition breaks it:
-- | Natural transformations
data ( FDom f1 ~ FDom f2
     , FCod f1 ~ FCod f2) 
    
    => NaturalTransformation f1 f2 
    
    = NaturalTransformation 
    { 
      nat :: ( Ob (FDom f1) a
             , Defined f1 a
             , Defined f2 a)

            => ((FCod f2) (FMap f1 a) (FMap f2 a)) -- ^ a-th component of the natural transformation
    }