
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
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
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 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.