<div dir="ltr"><div>So, does that mean I'm trying to do something impossible? <br></div><div><br></div><div>I'm often not clear on what higher-kinded types are doing, and I'm aware that sometimes I'm asking the compiler to do something that is logically impossible.</div><div><br></div><div>Or is there a correct way to do this?</div><div><br></div><div><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Wed, Jun 27, 2018 at 11:05 PM, David Kraeutmann <span dir="ltr"><<a href="mailto:kane@kane.cx" target="_blank">kane@kane.cx</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Apart from a bunch of minor errors, the crux here is that<br>
<span class=""><br>
class Monad m => LogMonad m where<br>
putReport :: ReportData t1 t2 -> m ()<br>
<br>
</span>has locally quantified type variables t1, t2, and thus the `r` in<br>
`putReport r` has type `ReportData a b` while the state type expects<br>
`ReportData x y`.<br>
<div class="HOEnZb"><div class="h5"><br>
<br>
On 06/28/2018 01:54 AM, Dennis Raddle wrote:<br>
> I created a minimal example of what I'm trying to do --- in fact, I<br>
> think this will be better than what I wrote in the first place --- but<br>
> now I'm baffled by a different error entirely, which is some<br>
> identifiers not in scope. I'm going to post this anyway, because I<br>
> suspect the error is related to what the compiler can infer about my<br>
> instance, which is something I need to understand better.<br>
><br>
> Once you get past that error, either it will be working (yay!) or<br>
> you'll encounter the error about no instance for MonadState which was<br>
> my original problem.<br>
><br>
> {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,<br>
> FlexibleContexts #-}<br>
><br>
><br>
> import Control.Monad.State<br>
> import System.Random<br>
><br>
> data ReportData t1 t2 = ReportData t1 t2<br>
><br>
> -- this is rolling my own state monad with a random generator<br>
> class Monad m => RandMonad m where<br>
> getGen :: m StdGen<br>
> putGen :: StdGen -> ()<br>
><br>
> -- this is a class of state monad which logs ReportData:<br>
><br>
> class Monad m => LogMonad m where<br>
> putReport :: ReportData t1 t2 -> m ()<br>
><br>
> -- For a particular use case, I declare a type of State monad:<br>
><br>
> data MyStateData t1 t2 = MyStateData t1 t2<br>
> { theGen :: StdGen<br>
> , theReports :: [ReportData t1 t2]<br>
> }<br>
><br>
> type MyState t1 t2 = State (MyStateData t1 t2)<br>
><br>
> -- And I try to define my instances:<br>
><br>
> instance RandMonad (MyState t1 t2) where<br>
> getGen = gets theGen<br>
> putGen g = modify (\s -> s { theGen = g}) -- ERROR : theGen not in<br>
> scope<br>
><br>
> instance LogMonad (MyState t1 t2) where<br>
> putReport r = modify (\s -> s { theReports = r : theReports s}) --<br>
> ERROR: theReports not in scope<br>
><br>
><br>
> On Wed, Jun 27, 2018 at 10:43 PM, Dennis Raddle<br>
</div></div><span class="im HOEnZb">> <<a href="mailto:dennis.raddle@gmail.com">dennis.raddle@gmail.com</a> <mailto:<a href="mailto:dennis.raddle@gmail.com">dennis.raddle@gmail.<wbr>com</a>>> wrote:<br>
><br>
> okay, will do. It has a lot of details that aren't really<br>
> necessary to ask the question, but now that I think about it, all<br>
> that's required of you is to download and try to compile it.<br>
><br>
> D<br>
><br>
> On Wed, Jun 27, 2018 at 10:41 PM, Tom Ellis<br>
> <<a href="mailto:tom-lists-haskell-cafe-2017@jaguarpaw.co.uk">tom-lists-haskell-cafe-2017@<wbr>jaguarpaw.co.uk</a><br>
</span><div class="HOEnZb"><div class="h5">> <mailto:<a href="mailto:tom-lists-haskell-cafe-2017@jaguarpaw.co.uk">tom-lists-haskell-<wbr>cafe-2017@jaguarpaw.co.uk</a>>> wrote:<br>
><br>
> Your sample code has a few bugs which make it not compile, for<br>
> example the<br>
> following is not valid syntax<br>
><br>
> data MyStateData t1 t2 = MyStateData t1 t2<br>
> { theGen :: StdGen<br>
> , theReports :: [StepReport t1 t2]<br>
> }<br>
><br>
> and you use "StepReport" when I think you mean "ReportData". <br>
> Could you post<br>
> a version which is completely working besides the error you<br>
> are trying to<br>
> solve? Otherwise it's rather hard to help.<br>
><br>
> Tom<br>
><br>
><br>
> On Wed, Jun 27, 2018 at 10:22:46PM -0700, Dennis Raddle wrote:<br>
> > I'm writing a program with several functions, some of which<br>
> depend on<br>
> > certain fields in a state monad, others of which depend on<br>
> others, but no<br>
> > routine needs all the fields.<br>
> ><br>
> > So I thought I would declare a two classes, one for each<br>
> type of data need<br>
> > that a function has:<br>
> ><br>
> > -- as an aside, here's an example of data which is<br>
> parameterized by two<br>
> > types.<br>
> ><br>
> > data ReportData t1 t2 = ...<br>
> ><br>
> > -- this is rolling my own state monad with a random generator<br>
> > class Monad m => RandMonad m where<br>
> > getGen :: m StdGen<br>
> > putGen :: StdGen -> ()<br>
> ><br>
> > -- this is a class of state monad which logs ReportData:<br>
> ><br>
> > class Monad m => LogMonad m where<br>
> > putReport :: ReportData t1 t2 -> m ()<br>
> ><br>
> > For a particular use case, I declare a type of State monad:<br>
> ><br>
> > data MyStateData t1 t2 = MyStateData t1 t2<br>
> > { theGen :: StdGen<br>
> > , theReports :: [StepReport t1 t2]<br>
> > }<br>
> ><br>
> > type MyState t1 t2 = State (MyStateData t1 t2)<br>
> ><br>
> > And I try to define my instances:<br>
> ><br>
> > instance RandMonad (MyState t1 t2) where<br>
> > getGen = gets theGen<br>
> > putGen g = modify (\s -> s { theGen = g})<br>
> ><br>
> > instance LogMonad (MyState t1 t2) where<br>
> > putReport r = modify (\s -> s { theReports = r :<br>
> theReports s})<br>
> ><br>
> > I get an error on the LogMonad instance, saying that there's<br>
> no instance<br>
> > for (MonadState (MyState t1 t2) (StateT (MyState t1 t2)<br>
> Identity))<br>
> ><br>
> > I guess I don't really understand typeclasses once you start<br>
> using higher<br>
> > kinded types, so please enlighten me. Any reading on this<br>
> subject would be<br>
> > helpful, too.<br>
><br>
> > ______________________________<wbr>_________________<br>
> > Haskell-Cafe mailing list<br>
> > To (un)subscribe, modify options or view archives go to:<br>
> ><br>
> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
> <<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a>><br>
> > Only members subscribed via the mailman list are allowed to<br>
> post.<br>
><br>
> ______________________________<wbr>_________________<br>
> Haskell-Cafe mailing list<br>
> To (un)subscribe, modify options or view archives go to:<br>
> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
> <<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a>><br>
> Only members subscribed via the mailman list are allowed to post.<br>
><br>
><br>
><br>
><br>
><br>
> ______________________________<wbr>_________________<br>
> Haskell-Cafe mailing list<br>
> To (un)subscribe, modify options or view archives go to:<br>
> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
> Only members subscribed via the mailman list are allowed to post.<br>
<br>
______________________________<wbr>_________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</div></div></blockquote></div><br></div>