Trying to test natural transformations, in Haskell.

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
participants (1)
-
David Banas