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