
Hi,
I think you may want to over think your types again.
Especially your Evaluator-Monad, and maybe your Map constructor.
The Problem is, due to your use of Either and the need for evalObs to
finally transform from "Obs [a]" type to "Evaluator [a]" you will end
up in another Monad for Either:
instance Monad (Either Actions) where
return = Right
(Left x) >>= _ = Left x
(Right a) >>= f = f a
Then one solution may be:
evalObs (Map f obs) = evalMap (f.Konst) (evalObs obs)
evalMap :: (a -> Obs b) -> Evaluator [a] -> Evaluator [b]
evalMap f o = liftE (map evalObs) (liftE (map f) o) >>= \x ->
case x of
Left actions -> return $ Left actions
Right evals -> sequence evals >>= return .
sequence
-- first "sequence evals" creates [Either Actions a]
-- second "sequence" create Either Actions [a]
After building up the "Evaluator [a]" construct inside your Evaluator-
Monad, you have to join the construct "evals" back into your real
Monad and since you pass around results using Either inside your
Evaluator-Monad, you have to treat the Either-type just like another
Monad.
If you get stuck on your types, define new toplevel functions (as
undefined) each taking one argument less and play with the types in
your files and in ghci until it begins to make sense.
On 26 Okt., 19:42, Dupont Corentin
Hey Chris! Values for PlayerNumber are acquired at evaluation time, from the state of the system.
I have not included the evaluation of AllPlayers. Here how it looks:
evalObs AllPlayers = return . pure =<< gets players
But when you build your Obs, you have yet no idea how much players it will be. This is just symbolic at this stage.
To give you a better insight, here is want I want to do with Map:
everybodyVote :: Obs [Bool] everybodyVote = Map (Vote (Konst "Please vote")) AllPlayers
In memory, everybodyVote is just a tree. This rule can be executed latter whenever I want to perform this democratic vote ;)
Hope this answer to your question. Corentin
On Tue, Oct 26, 2010 at 7:17 PM, Christopher Done
wrote: On 26 October 2010 18:07, Dupont Corentin
wrote: But how can I write the evaluator for Map?
Where do values for PlayerNumber come from? Unless I'm mistaken, the only thing that Map can be used with is Obs [PlayerNumber], a list of values PlayerNumber which we have no means of acquiring in order to provide to the Map function.
_______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe