
Hello the list, I have another silly question. In my software I have a very common pattern: --in file A.hs module A where data A = A {b :: B, i :: Int} type SA x = State A x -- many functions with SA x --in file B.hs data B = B {r :: Int} type SB x = State B x -- many functions with SB x Of course in module A I'm calling some functions of module B. I'd like to know if it's possible, in a function of type SA, to call a function of type SB, without actually executing the State SB. I just wanna tell him "Hey look, you can construct a SA from a SB like this!" For now I have this: bToA:: (B -> B) -> A -> A bToA bb = (λa -> a{b = bb (b a)}) useB :: SB () -> SA () useB = modify . bToA . execState Can I get rid of the execState? Also, I can't manage to write the more generic function SB x -> SA x. Cheers, Corentin

2010/10/29 Dupont Corentin
Of course in module A I'm calling some functions of module B. I'd like to know if it's possible, in a function of type SA, to call a function of type SB, without actually executing the State SB. I just wanna tell him "Hey look, you can construct a SA from a SB like this!"
Also, I can't manage to write the more generic function SB x -> SA x.
You can have a class that expresses the operations upon some B, e.g. class MonadB m where getB :: m b and then implement that class for both SA and SB. Or you can implement MonadTrans in order to write the more generic function SB x -> SA x. Possibly both but preferably the former imho.

2010/10/29 Dupont Corentin
Also, I can't manage to write the more generic function SB x -> SA x.
Horribly enough this one seems to work... mapOnBofA :: SB a -> SA a mapOnBofA mf = get >>= \st@(A {b=temp}) -> let (ans,temp2) = runState mf temp in put (st { b=temp2}) >> return ans However, I'd have to question why you want both SA and SB as state functional types. Having inner runState's is sometimes good practice (its an instance of the Local Effect pattern identified by Ralf Laemmel and Joost Visser), but if you have it "commonly" I'd suspect you design is somehow contrived and could be simplified.

Horribly enough this one seems to work...
mapOnBofA :: SB a -> SA a mapOnBofA mf = get >>= \st@(A {b=temp}) -> let (ans,temp2) = runState mf temp in put (st { b=temp2}) >> return ans
There is nothing horrible about that. You just run a new isolated
computation in the State Monad for B and use its results. More or less
see same solution as Dupont's.
@Dupont:
telling from your possible use case and your last post with your "MAP"-
Problem, these two are very similar. You have a monad and inside your
monad you temporarily want to run some computation in another Monad. I
think Monad-Transformers are maybe the better option for you
(especially your interpreter-Problem was a good use case for StateT/
ErrorT instead of State and some Either inside it...).
On 29 Okt., 17:35, Stephen Tetley
2010/10/29 Dupont Corentin
: Also, I can't manage to write the more generic function SB x -> SA x.
However, I'd have to question why you want both SA and SB as state functional types. Having inner runState's is sometimes good practice (its an instance of the Local Effect pattern identified by Ralf Laemmel and Joost Visser), but if you have it "commonly" I'd suspect you design is somehow contrived and could be simplified. _______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe

Thank you for your responses. I will look at monad transformers.
I already use them I think because actually I use something like StateT Game
IO a.
You mean I have to implement my own instance?
Oh, can you call me Corentin? This is my name ;)
Cheers,
Corentin
On Fri, Oct 29, 2010 at 6:19 PM, steffen
Horribly enough this one seems to work...
mapOnBofA :: SB a -> SA a mapOnBofA mf = get >>= \st@(A {b=temp}) -> let (ans,temp2) = runState mf temp in put (st { b=temp2}) >> return ans
There is nothing horrible about that. You just run a new isolated computation in the State Monad for B and use its results. More or less see same solution as Dupont's.
@Dupont: telling from your possible use case and your last post with your "MAP"- Problem, these two are very similar. You have a monad and inside your monad you temporarily want to run some computation in another Monad. I think Monad-Transformers are maybe the better option for you (especially your interpreter-Problem was a good use case for StateT/ ErrorT instead of State and some Either inside it...).
On 29 Okt., 17:35, Stephen Tetley
wrote: 2010/10/29 Dupont Corentin
: Also, I can't manage to write the more generic function SB x -> SA x.
However, I'd have to question why you want both SA and SB as state functional types. Having inner runState's is sometimes good practice (its an instance of the Local Effect pattern identified by Ralf Laemmel and Joost Visser), but if you have it "commonly" I'd suspect you design is somehow contrived and could be simplified. _______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp:// www.haskell.org/mailman/listinfo/haskell-cafe
Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Nothing hinders you writing:
StateT Game (StateT A IO)
or
GameT mt = ErrorT Err (StateT Game (mt IO))
with mt being another Monad-Transformer
Monad-Transformers can be quite tricky. The point is you don't have to
create new Monad instances.
On 29 Okt., 18:46, Dupont Corentin
Thank you for your responses. I will look at monad transformers. I already use them I think because actually I use something like StateT Game IO a. You mean I have to implement my own instance?
Oh, can you call me Corentin? This is my name ;)
Cheers, Corentin
On Fri, Oct 29, 2010 at 6:19 PM, steffen
wrote: Horribly enough this one seems to work...
mapOnBofA :: SB a -> SA a mapOnBofA mf = get >>= \st@(A {b=temp}) -> let (ans,temp2) = runState mf temp in put (st { b=temp2}) >> return ans
There is nothing horrible about that. You just run a new isolated computation in the State Monad for B and use its results. More or less see same solution as Dupont's.
@Dupont: telling from your possible use case and your last post with your "MAP"- Problem, these two are very similar. You have a monad and inside your monad you temporarily want to run some computation in another Monad. I think Monad-Transformers are maybe the better option for you (especially your interpreter-Problem was a good use case for StateT/ ErrorT instead of State and some Either inside it...).
On 29 Okt., 17:35, Stephen Tetley
wrote: 2010/10/29 Dupont Corentin
: Also, I can't manage to write the more generic function SB x -> SA x.
However, I'd have to question why you want both SA and SB as state functional types. Having inner runState's is sometimes good practice (its an instance of the Local Effect pattern identified by Ralf Laemmel and Joost Visser), but if you have it "commonly" I'd suspect you design is somehow contrived and could be simplified. _______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp:// www.haskell.org/mailman/listinfo/haskell-cafe _______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe

you can find a nice introduction on using monad transformers by
developing an interpreter at [1] and a little more detailed one at [2]
[1]http://www.grabmueller.de/martin/www/pub/Transformers.pdf
[2]http://www.haskell.org/all_about_monads/html/
On 29 Okt., 18:46, Dupont Corentin
Thank you for your responses. I will look at monad transformers. I already use them I think because actually I use something like StateT Game IO a. You mean I have to implement my own instance?
Oh, can you call me Corentin? This is my name ;)
Cheers, Corentin
On Fri, Oct 29, 2010 at 6:19 PM, steffen
wrote: Horribly enough this one seems to work...
mapOnBofA :: SB a -> SA a mapOnBofA mf = get >>= \st@(A {b=temp}) -> let (ans,temp2) = runState mf temp in put (st { b=temp2}) >> return ans
There is nothing horrible about that. You just run a new isolated computation in the State Monad for B and use its results. More or less see same solution as Dupont's.
@Dupont: telling from your possible use case and your last post with your "MAP"- Problem, these two are very similar. You have a monad and inside your monad you temporarily want to run some computation in another Monad. I think Monad-Transformers are maybe the better option for you (especially your interpreter-Problem was a good use case for StateT/ ErrorT instead of State and some Either inside it...).
On 29 Okt., 17:35, Stephen Tetley
wrote: 2010/10/29 Dupont Corentin
: Also, I can't manage to write the more generic function SB x -> SA x.
However, I'd have to question why you want both SA and SB as state functional types. Having inner runState's is sometimes good practice (its an instance of the Local Effect pattern identified by Ralf Laemmel and Joost Visser), but if you have it "commonly" I'd suspect you design is somehow contrived and could be simplified. _______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp:// www.haskell.org/mailman/listinfo/haskell-cafe _______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe
participants (4)
-
Christopher Done
-
Dupont Corentin
-
steffen
-
Stephen Tetley