How to define an instance of Control.Functor.Constrained?

Question

I'm trying to define an instance of Functor.Constrained, after successfully defining an instance of Category.Constrained. However the type of Functor.Constrained fmap is complex and the attempt I made led to an error that I can't explain. How do you define all the objects required by the fmap type?

Control.Functor.Constrained
fmap :: (Object r a, Object t (f a), Object r b, Object t (f b)) => r a b -> t (f a) (f b)

http://hackage.haskell.org/package/constrained-categories-0.3.1.1

{-# LANGUAGE GADTs, TypeFamilies, ConstraintKinds #-}

module Question1 where

import Control.Category.Constrained
import Control.Functor.Constrained as FC 
import Data.Map as M
import Data.Set as S

data RelationMS a b where
  IdRMS :: RelationMS a a
  RMS :: Map a (Set b) -> RelationMS a b 

instance Category RelationMS where
    type Object RelationMS o = Ord o
    id = IdRMS
    (.) = compRMS

compRMS :: (Ord a, Ord k, Ord b) => RelationMS k b -> RelationMS a k -> RelationMS a b 
RMS mp2 `compRMS` RMS mp1
  | M.null mp2 || M.null mp1 = RMS M.empty
  | otherwise = RMS $ M.foldrWithKey 
        (\k s acc -> M.insert k (S.foldr (\x acc2 -> case M.lookup x mp2 of
                                                    Nothing -> acc2
                                                    Just s2 -> S.union s2 acc2
                                         ) S.empty s
                                ) acc
        ) M.empty mp1

pseudoFmap :: Ord c =>  (b -> c) -> RelationMS a b -> RelationMS a c
pseudoFmap f (RMS r) = RMS $ M.map (S.map f) r

instance FC.Functor RelationMS where
    -- error: ‘Object’ is not a (visible) associated type of class ‘Functor’
    type Object RelationMS o = Ord o
    fmap f (RMS r) = pseudoFmap f (RMS r)

----------- TO CHECK THE PROPOSED SOLUTION ---------

instance (Show a, Show b) => Show (RelationMS a b) where
        show (IdRMS) = "IdRMS"
        show (RMS r) = show r


> FC.fmap (+1) (RMS $ M.fromList [(1,S.fromList [10,20]), (2,S.fromList [30,40])])
> fromList [(1,fromList [11,21]),(2,fromList [31,41])]

Answer 1

{-# LANGUAGE GADTs, TypeFamilies, ConstraintKinds, FlexibleInstances
  , MultiParamTypeClasses, StandaloneDeriving #-}

module Question1 where

import Prelude hiding (($))

import Control.Category.Constrained
import Control.Functor.Constrained as FC 
import Control.Arrow.Constrained (($))
import Data.Map as M
import Data.Set as S
import Data.Constraint.Trivial


main :: IO ()
main = print $ FC.fmap f
         $ RMS (M.fromList [(1,S.fromList [11,21]),(2,S.fromList [31,41])])
 where f :: ConstrainedCategory (->) Ord Int Int
       f = constrained (+1)


data RelationMS a b where
  IdRMS :: RelationMS a a
  RMS :: Map a (Set b) -> RelationMS a b 
deriving instance (Show a, Show b) => Show (RelationMS a b)

instance Category RelationMS where
    type Object RelationMS o = Ord o
    id = IdRMS
    (.) = compRMS

compRMS :: (Ord a, Ord k, Ord b) => RelationMS k b -> RelationMS a k -> RelationMS a b 
RMS mp2 `compRMS` RMS mp1
  | M.null mp2 || M.null mp1 = RMS M.empty
  | otherwise = RMS $ M.foldrWithKey 
        (\k s acc -> M.insert k (S.foldr (\x acc2 -> case M.lookup x mp2 of
                                                    Nothing -> acc2
                                                    Just s2 -> S.union s2 acc2
                                         ) S.empty s
                                ) acc
        ) M.empty mp1

pseudoFmap :: Ord c =>  (b -> c) -> RelationMS a b -> RelationMS a c
pseudoFmap f (RMS r) = RMS $ M.map (S.map f) r

instance FC.Functor (RelationMS a)
                    (ConstrainedCategory (->) Ord)
                    (ConstrainedCategory (->) Unconstrained) where
    fmap (ConstrainedMorphism f) = ConstrainedMorphism $
            \(RMS r) -> pseudoFmap f (RMS r)

RMS (fromList [(1,fromList [12,22]),(2,fromList [32,42])])

BTW, you can make the definitions of those maps and sets easier to type/read with a syntactic extension:

{-# LANGUAGE OverloadedLists #-}
main :: IO ()
main = print $ FC.fmap f $ RMS [(1, [11,21]),(2, [31,41])]
 where f :: ConstrainedCategory (->) Ord Int Int
       f = constrained (+1)

Talking about syntactic sugar: with constrained-categories>=0.4, you can also shorten the type signature

{-# LANGUAGE TypeOperators #-}
main = print $ FC.fmap f
         $ RMS (M.fromList [(1,S.fromList [11,21]),(2,S.fromList [31,41])])
 where f :: (Ord⊢(->)) Int Int
       f = constrained (+1)

or even omit it entirely and instead specify the constraint with a type application on constrained:

{-# LANGUAGE TypeApplications, OverloadedLists #-}
main :: IO ()
main = print $ FC.fmap (constrained @Ord (+1))
              $ RMS ([(1,[11,21]),(2,[31,41])])

Also, there's now the synonym Hask for the oxymoronic-looking ConstrainedCategory (->) Unconstrained, so you can simplify the instance head to

instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) Hask

Answer 2

You probably don't mean to make RelationMS a Functor (it can be made one, but not with constrained-categories). You mean to make RelationMS a a Functor for all a; you want Functor (RelationMS a). Also, Functors exist between two Categorys, so you must define the Categorys that RelationMS a is a Functor between. The source category is ConstrainedCategory (->) Ord, and the output category is (->). However, there's a "default" instance Prelude.Functor f => FC.Functor f (->) (->) instance that stops instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) (->) from working, due to a fundep conflict. Define this newtype

newtype Fun a b = Fun { runFun :: a -> b }
instance Category Fun where
  id = Fun Prelude.id
  Fun f . Fun g = Fun (f Prelude.. g)

That's two of Functor's superclasses satisfied, and the third one is satisfied as Object Fun o = (). So, you get

instance FC.Functor (RelationMS a) (ConstrainedCategory (->) Ord) Fun where
  fmap = Fun Prelude.. pseudoFmap Prelude.. unconstrained