<div dir="ltr"><div><div>The problem is in your string -> WriterT w m a.  It needs to know what the w is.  It knows its a monoid but doesn't know anything else about it.  The simplest thing is to just tell it what it is.<br><br>foldrEntries :: (Entry -> a -> a) -> a -> (String -> a) -> Entries -> a<br>foldrEntries next done fail' es = runIdentity $ return . fst =<< runWriterT foldIt<br>  where<br>    foldIt = foldrEntriesW (\e -> return . next e) (return done) ((return :: Monad m => a -> WriterT () m a) . fail') es<br><br></div>A second option is to give foldIt a type signature.  Unfortunately if you want the a in foldIt to match the a in foldEntries, you have to use scoped type variables extension.  Normally the two signatures are not related and the compiler figures both a's are not the same as each other.<br><br></div>{-# LANGUAGE ScopedTypeVariables #-}<br><br>...<br><div><br>foldrEntries :: forall a. (Entry -> a -> a) -> a -> (String -> a) -> Entries -> a<br>foldrEntries next done fail' es = runIdentity $ return . fst =<< runWriterT foldIt<br>  where<br>    foldIt :: Monad m => WriterT () m a<br>    foldIt = foldrEntriesW (\e -> return . next e) (return done) (return . fail') es<br><div><br></div></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Fri, Nov 20, 2015 at 7:14 AM, Martin Vlk <span dir="ltr"><<a href="mailto:martin@vlkk.cz" target="_blank">martin@vlkk.cz</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Hi I have two functions, foldrEntries and foldrEntriesW, where the<br>
latter is a WriterT version of the former. Here are the type signatures:<br>
<br>
foldrEntries :: (Entry -> a -> a) -><br>
                a -><br>
                (String -> a) -><br>
                Entries -><br>
                a<br>
<br>
foldrEntriesW :: (Monoid w, Monad m) =><br>
                 (Entry -> a -> WriterT w m a) -><br>
                 WriterT w m a -><br>
                 (String -> WriterT w m a) -><br>
                 Entries -><br>
                 WriterT w m a<br>
<br>
I want to implement foldrEntries in terms of foldrEntriesW using the<br>
Identity monad and ignore/not use the writer result. I am doing this in<br>
order to reuse the foldrEntriesW implementation and avoid code duplication.<br>
<br>
This is what I have so far:<br>
<a href="http://lpaste.net/145641" rel="noreferrer" target="_blank">http://lpaste.net/145641</a><br>
<br>
But the compiler complains about ambiguous type for the writer reult I<br>
am ignoring (message in the above lpaste).<br>
<br>
Normally I think the way around this is to provide explicit type<br>
annotation for "foldIt", but in this case the result type depends on the<br>
type of "a" in foldrEntries type and I don't know how to express this<br>
and make the compiler happy.<br>
<br>
(I was able to make it work by calling "tell ()", basically writing a<br>
dummy value, which lets compiler know what the type is, but this is not<br>
so good - I don't want to make artificial function calls like this.)<br>
<br>
Can anybody help me with that?<br>
<br>
Many Thanks<br>
Martin<br>
_______________________________________________<br>
Beginners mailing list<br>
<a href="mailto:Beginners@haskell.org">Beginners@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners</a><br>
</blockquote></div><br></div>