
Hi all, In doing the challenge problems at the end of chapter 10 (Natural Transformations) in Bartosz Milewski’s “Category Theory for Programmers”, I’m trying to write a generic naturality checker: {-# LANGUAGE Rank2Types AllowAmbiguousTypes #-} type NatTran a = (Functor f, Functor f') => f a -> f' a to_assert :: (Functor f, Eq b) => (a -> b) -> NatTran a -> NatTran b -> f a -> Bool to_assert g h h' f = (fmap g . h) f == (h' . fmap g) f which is later made specific to a particular natural transformation: maybe_to_list :: Maybe a -> [a] maybe_to_list Nothing = [] maybe_to_list (Just x) = [x] test_func :: Num a => a -> (a, a) test_func x = (x, x + 1) assertions = map (to_assert test_func maybe_to_list) [Nothing, Just 1] but I’m getting this from ghc: Could not deduce (Functor f0) arising from a use of ‘fmap’ from the context (Functor f, Eq b) bound by the type signature for interactive:IHaskell465.to_assert :: (Functor f, Eq b) => (a -> b) -> interactive:IHaskell465.NatTran a -> interactive:IHaskell465.NatTran b -> f a -> Bool at :2:14-83 The type variable ‘f0’ is ambiguous Note: there are several potential instances: instance Monad m => Functor (Data.Vector.Fusion.Bundle.Monadic.Bundle m v) -- Defined in ‘Data.Vector.Fusion.Bundle.Monadic’ instance Functor Data.Vector.Fusion.Util.Box -- Defined in ‘Data.Vector.Fusion.Util’ instance Functor Data.Vector.Fusion.Util.Id -- Defined in ‘Data.Vector.Fusion.Util’ ...plus 27 others In the first argument of ‘(.)’, namely ‘fmap g’ In the expression: fmap g . h In the first argument of ‘(==)’, namely ‘(fmap g . h) f’ Can anyone offer some advice? Thanks, -db