My rule of thumb is to also always have scoped type variables enabled in my own code. <div><br></div><div><br></div><div>I also strongly advise against allow ambiguous types, it's seldom what you want. <span></span><br><br>On Thursday, June 16, 2016, David Banas <<a href="mailto:capn.freako@gmail.com">capn.freako@gmail.com</a>> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div style="word-wrap:break-word"><div>Got it:</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="Menlo">{-# LANGUAGE Rank2Types</font></div></div><div><div><font face="Menlo">             AllowAmbiguousTypes</font></div></div><div><div><font face="Menlo">             FlexibleContexts</font></div></div><div><div><font face="Menlo">  #-}</font></div></div><div><div><font face="Menlo"><br></font></div></div><div><div><font face="Menlo">type NatTran f f' a = (Functor f, Functor f') => f a -> f' a</font></div></div><div><div><font face="Menlo"><br></font></div></div><div><div><font face="Menlo">to_assert :: (Functor f, Functor f', Eq (f' b)) => (a -> b) -> NatTran f f' a -> NatTran f f' b -> f a -> Bool</font></div></div><div><div><font face="Menlo">to_assert g h h' f = (fmap g . h) f == (h' . fmap g) f</font></div></div><div><div><font face="Menlo"><br></font></div></div><div><div><font face="Menlo">maybe_to_list :: NatTran Maybe [] a</font></div></div><div><div><font face="Menlo">maybe_to_list Nothing  = []</font></div></div><div><div><font face="Menlo">maybe_to_list (Just x) = [x]</font></div></div><div><div><font face="Menlo"><br></font></div></div><div><div><font face="Menlo">test_func :: Num a => a -> (a, a)</font></div></div><div><div><font face="Menlo">test_func x = (x, x + 1)</font></div></div><div><div><font face="Menlo"><br></font></div></div><div><div><font face="Menlo">success = all (to_assert test_func maybe_to_list maybe_to_list) [Nothing, Just 1]</font></div></div><div><div><font face="Menlo"><br></font></div></div><div><div><font face="Menlo">main :: IO ()</font></div></div><div><div><font face="Menlo">main = do</font></div></div><div><div><font face="Menlo">    if success then print "Success!" else print "Failure."</font></div></div><div><div><font face="Menlo">    </font></div></div><div><div><font face="Menlo">main</font></div></div></blockquote><div><div><br></div></div><div>Running this code produces:</div><div><br></div><div><pre style="overflow:auto;font-size:14px;padding:0px;margin-top:0px;margin-bottom:0px;line-height:inherit;word-break:break-all;word-wrap:break-word;border:0px;border-top-left-radius:0px;border-top-right-radius:0px;border-bottom-right-radius:0px;border-bottom-left-radius:0px;white-space:pre-wrap;vertical-align:baseline">"Success!"</pre><div><br></div></div><div>=================================================</div><div><br></div>Hi all,<div><br></div><div>In doing the challenge problems at the end of chapter 10 (<i>Natural Transformations</i>) in Bartosz Milewski’s “Category Theory for Programmers”, I’m trying to write a generic naturality checker:</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><font face="Menlo">{-# LANGUAGE Rank2Types</font></div><div><font face="Menlo">             AllowAmbiguousTypes</font></div><div><font face="Menlo">  #-}</font></div><div><font face="Menlo"><br></font></div><div><font face="Menlo">type NatTran a = (Functor f, Functor f') => f a -> f' a</font></div><div><font face="Menlo"><br></font></div><div><font face="Menlo">to_assert :: (Functor f, Eq b) => (a -> b) -> NatTran a -> NatTran b -> f a -> Bool</font></div><div><font face="Menlo">to_assert g h h' f = (fmap g . h) f == (h' . fmap g) f</font></div></blockquote><div><br></div><div>which is later made specific to a particular natural transformation:</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><font face="Menlo">maybe_to_list :: Maybe a -> [a]</font></div><div><font face="Menlo">maybe_to_list Nothing  = []</font></div><div><font face="Menlo">maybe_to_list (Just x) = [x]</font></div><div><font face="Menlo"><br></font></div><div><font face="Menlo">test_func :: Num a => a -> (a, a)</font></div><div><font face="Menlo">test_func x = (x, x + 1)</font></div><div><font face="Menlo"><br></font></div><div><font face="Menlo">assertions = map (to_assert test_func maybe_to_list) [Nothing, Just 1]</font></div></blockquote><div><br></div><div>but I’m getting this from ghc:</div><div><br></div><div><span style="color:rgb(255,0,0);font-family:monospace;font-size:14px;font-style:italic;white-space:pre-wrap;background-color:rgb(255,255,255)">Could not deduce (Functor f0) arising from a use of ‘fmap’</span><br style="color:rgb(255,0,0);font-family:monospace;font-size:14px;font-style:italic;white-space:pre-wrap"><span style="color:rgb(255,0,0);font-family:monospace;font-size:14px;font-style:italic;white-space:pre-wrap;background-color:rgb(255,255,255)">from the context (Functor f, Eq b)</span><br style="color:rgb(255,0,0);font-family:monospace;font-size:14px;font-style:italic;white-space:pre-wrap"><span style="color:rgb(255,0,0);font-family:monospace;font-size:14px;font-style:italic;white-space:pre-wrap;background-color:rgb(255,255,255)">  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 </span><u></u>:2:14-83<br>The type variable ‘f0’ is ambiguous<br>Note: there are several potential instances:<br>  instance Monad m => Functor (Data.Vector.Fusion.Bundle.Monadic.Bundle m v) -- Defined in ‘Data.Vector.Fusion.Bundle.Monadic’<br>  instance Functor Data.Vector.Fusion.Util.Box -- Defined in ‘Data.Vector.Fusion.Util’<br>  instance Functor <a href="http://Data.Vector.Fusion.Util.Id" target="_blank">Data.Vector.Fusion.Util.Id</a> -- Defined in ‘Data.Vector.Fusion.Util’<br>  ...plus 27 others<br>In the first argument of ‘(.)’, namely ‘fmap g’<br>In the expression: fmap g . h<br>In the first argument of ‘(==)’, namely ‘(fmap g . h) f’<br><u></u></div><div><u></u><br><u></u></div><div>Can anyone offer some advice?</div><div><br></div><div>Thanks,</div><div>-db</div><div><br></div><div><br></div></div></blockquote></div>