I'm currently trying to create a snake-like game in haskell using hscurses in the terminal, and I'm having a bit of trouble implementing the input-functionality of the game. My problem is that whenever I hold down one of the movement keys, for example 'a', the character moves to the left for as many characters that were registered by the console. This leads to when I want to switch directions, for example down by pressing 's', the character keeps on moving to the left and the down-movement gets delayed.
res :: Int -> IO a -> IO (Maybe a)
res n f = concurrently (System.Timeout.timeout n f) (threadDelay n) >>= \(result, _) -> return
result
getInput :: IO Char
getInput = hSetEcho stdin False
>> hSetBuffering stdin NoBuffering
>> getChar
and the part of the main game-loop function that handles the input:
loop :: Window -> State -> Player -> IO State
loop window state player = do
threadDelay 1000000
k <- res 100 getInput
newState <- updateState player state
newPlayer <- movePlayer player k
render newState newPlayer window
and the movePlayer function:
movePlayer :: Player -> Maybe Char -> IO Player
movePlayer Player {xy=xy1, direction = d} k =
case k of
Just 'w' -> return Player {xy = (fst xy1, snd xy1-1), direction = Up}
Just 's' -> return Player {xy = (fst xy1, snd xy1+1), direction = Downie}
Just 'd' -> return Player {xy = (fst xy1+1, snd xy1), direction = Rightie}
Just 'a' -> return Player {xy = (fst xy1-1, snd xy1), direction = Leftie}
Nothing -> return Player {xy = addVecs xy1 (dirToVec d), direction = d}
_ -> return Player {xy = xy1, direction = d}
I can't figure out what the problem is, so any help is appreciated or if there's another method of implementing this input-functionality
Currently your input loop and your state update loop are tied together: there's always at most one input accepted per update. You will need to desynch them.
The low-tech alternative is to change the spot you currently have res 100 getInput to actually run getInput in a loop, and only keep the last Char it receives before blocking. The medium-tech alternative is to have two threads, one for reading input and one for doing state updates, with a shared MVar or similar saying what key was pressed last. The high-tech alternative is to use a library like brick to handle all of your input and output.
Related
I'm using IO to encapsulate randomness. I am trying to write a method which iterates a next function n times, but the next function produces a result wrapped in IO because of the randomness.
Basically, my next function has this signature:
next :: IO Frame -> IO Frame
and I want to start with an initial Frame, then use the same pattern as iterate to get a list [Frame] with length n. Essentially, I'd like to be able to write the following:
runSimulation :: {- parameters -} -> IO [Frame]
runSimulation {- parameters -} = do
{- some setup -}
sequence . take n . iterate next $ firstFrame
Where firstFrame :: IO Frame formed by doing something like let firstFrame = return Frame x y z.
The problem I am encountering is that when I run this function, it never exits, so it seems to be running on an infinite loop (since iterate produces an infinite list).
I'm quite new to haskell so not sure where I'm going wrong here, or if my supposition above is correct that it seems that the entire infinite list is being executed.
(Update) In case it's helpful, here are the full definitions of Frame, next, and runSimulation:
-- A simulation Frame encapsulates the state of the simulation at some
-- point in "time". That means it contains a list of Agents in that
-- Frame, and a list of the Interactions that occurred in it as well. It
-- also contains the state of the World, as well as an AgentID counter
-- (so we can easily increment for generating new Agents).
data Frame = Frame AgentID [Agent] [Interaction]
deriving Show
-- Generate the next Frame from the current one, including scoring the
-- Agents based on the outcomes *in this Frame*.
-- TODO: add in reproduction.
nextFrame :: Reactor -> World -> IO Frame -> IO Frame
nextFrame react w inp = do
(Frame i agents history) <- inp
interactions <- interactAll react history agents
let scoredAgents = scoreAgents (rewards w) interactions agents
return (Frame i scoredAgents interactions)
-- Run a simulation for a number of iterations
runSimulation :: World -> Reactor -> (Dist, Dist) -> IO [Frame]
runSimulation world react (gen_dist, sel_dist) = do
startingAgents <- spawnAgents (initial_size world) (agentCreatorFactory gen_dist sel_dist)
let firstFrame = return (Frame (length startingAgents) startingAgents [])
next = nextFrame react world
sequence . take (iterations world) . iterate next $ firstFrame
I don't know how much time computing each Frame takes, but I suspect you are doing more work than necessary. The cause is a bit subtle. iterate produces a list of repeated applications of a function. For each element in the list, the previous value is reused. Your list is composed of IO actions. The IO action at position n is computed from the already obtained IO action at position n-1 by applying next.
Alas, when executing those actions, we are not so lucky. Executing the action at position n in the list will repeat all the work of the previous actions! We shared work when building the actions themselves (which are values, like almost everything in Haskell) but not when executing them, which is a different thing.
The simplest solution could be to define this auxiliary function with a baked-in limit:
iterateM :: Monad m => (a -> m a) -> a -> Int -> m [a]
iterateM step = go
where
go _ 0 = return []
go current limit =
do next <- step current
(current:) <$> go next (pred limit)
While simple, it's a bit inelegant, for two reasons:
It conflates the iteration process with the limiting of such process. In the pure list world we didn't have to do that, we could create infinite lists and take from then. But now in the effectful world that nice compositionality seems to be lost.
What if we want to do something with each value as it is being produced, without having to wait for all of them? Out function returns everything at the end, in one go.
As mentioned in the comments, streaming libraries like "conduit", "streamly" or "streaming" try to solve this problem in a better way, regaining some of the compositionality of pure lists. These libraries have types that represent effectful processes whose results are yielded piecewise.
For example, consider the function Streaming.Prelude.iterateM from "streaming", specialized to IO:
iterateM :: (a -> IO a) -> IO a -> Stream (Of a) IO r
It returns a Stream that we can "limit" using Streaming.Prelude.take:
take :: Int -> Stream (Of a) IO r -> Stream (Of a) IO ()
after limiting it we can get back to IO [a] with Streaming.Prelude.toList_ which accumulates all results:
toList_ :: Stream (Of a) IO r -> IO [a]
But instead of that we could process each element as it is being produced, with functions like Streaming.Prelude.mapM_:
mapM_ :: (a -> IO x) -> Stream (Of a) IO r -> IO r
An elementary solution:
As an alternative to #danidiaz's answer, it is possible to solve the problem without resorting to extra libraries such as Streaming, assuming the role of IO can be minimized.
Most of the required code can be written in terms of the MonadRandom class, of which IO is just one instance. It is not necessary to use IO in order to generate pseudo-random numbers.
The required iteration function can be written like this, in do notation:
import System.Random
import Control.Monad.Random.Lazy
iterateM1 :: MonadRandom mr => (a -> mr a) -> a -> mr [a]
iterateM1 fn x0 =
do
y <- fn x0
ys <- iterateM1 fn y
return (x0:ys)
Unfortunately, the text of the question does not define exactly what a Frame object is, or what the next stepping function does; so I have to somehow fill in the blanks. Also the next name gets defined in the libraries involved, so I will have to use nextFrame instead of just next.
Let's assume that a Frame object is just a point in 3-dimensional space, and that at each random step, one and only one of the 3 dimensions is chosen at random, and the corresponding coordinate is bumped by an amount of either +1 or -1, with equal probabilities.
This gives this code:
data Frame = Frame Int Int Int deriving Show
nextFrame :: MonadRandom mr => Frame -> mr Frame
nextFrame (Frame x y z) =
do
-- 3 dimensions times 2 possible steps: 1 & -1, hence 6 possibilities
n <- getRandomR (0::Int, 5::Int)
let fr = case n of
0 -> Frame (x-1) y z
1 -> Frame (x+1) y z
2 -> Frame x (y-1) z
3 -> Frame x (y+1) z
4 -> Frame x y (z-1)
5 -> Frame x y (z+1)
_ -> Frame x y z
return fr
At that point, it is not difficult to write code that builds an unlimited list of Frame objects representing the simulation history. Creating that list does not cause the code to loop forever, and the usual take function can be used to select the first few elements of such a list.
Putting all the code together:
import System.Random
import Control.Monad.Random.Lazy
iterateM1 :: MonadRandom mr => (a -> mr a) -> a -> mr [a]
iterateM1 fn x0 =
do
y <- fn x0
ys <- iterateM1 fn y
return (x0:ys)
data Frame = Frame Int Int Int deriving Show
nextFrame :: MonadRandom mr => Frame -> mr Frame
nextFrame (Frame x y z) =
do
-- 3 dimensions times 2 possible steps: 1 & -1, hence 6 possibilities
n <- getRandomR (0::Int, 5::Int)
let fr = case n of
0 -> Frame (x-1) y z
1 -> Frame (x+1) y z
2 -> Frame x (y-1) z
3 -> Frame x (y+1) z
4 -> Frame x y (z-1)
5 -> Frame x y (z+1)
_ -> Frame x y z
return fr
runSimulation :: MonadRandom mr => Int -> Int -> Int -> mr [Frame]
runSimulation x y z = let fr0 = Frame x y z in iterateM1 nextFrame fr0
main = do
rng0 <- getStdGen -- PRNG hosted in IO monad
-- Could use mkStdGen or MkTFGen instead
let
sim = runSimulation 0 0 0
allFrames = evalRand sim rng0 -- unlimited list of frames !
frameCount = 10
frames = take frameCount allFrames
mapM_ (putStrLn . show) frames
Program execution:
$ ./frame
Frame 0 0 0
Frame 0 1 0
Frame 0 0 0
Frame 0 (-1) 0
Frame 1 (-1) 0
Frame 1 (-2) 0
Frame 1 (-1) 0
Frame 1 (-1) 1
Frame 1 0 1
Frame 2 0 1
$
For large values of frameCount, execution time is a quasi-linear function of frameCount, as expected.
More on monadic actions for random number generation here.
Given the following:
integralB :: Num a => Behavior t a -> Behavior t a -- definite integral of a behaviour
eJump :: Event t a -- tells the player to jump
bYAccel = pure 4000 -- y acceleration
bYVel = integralB bYAccel -- y velocity
bY = integralB bYVel -- y position
How do I make the player jump (probably by setting its y velocity) when a jump event arrives?
You'll need to be able to apply an impulse to the Y velocity for the jump. From your own answer, you've come up with a way to do so by summing all the impulses from the jumps and adding them to the integral of the acceleration.
Your acceleration is also constant. If you don't want the player falling constantly, you'd need something like:
bYAccel = (ifB airborne) 4000 0
airborne = fmap (>0) bY
ifB :: Behavior t Bool -> a -> a -> Behavior t a
ifB boolBehavior yes no = fmap (\bool -> if bool then yes else no) boolBehavior
One possible reason the height of your jumps varies is you aren't resetting the velocity when the player lands. If you have rules that hold the player above some position (like the floor), and are somehow stopping acceleration when the player hits the floor, you will also need to set the velocity to 0 if it is in the direction of the floor. (If you also set it to 0 when it's not in the direction of the floor, the player can never get the velocity to leave the ground.)
The reason this would cause erratic jumping heights is that the final velocity when the player lands will be close to the impulse you applied for them to take off. Using your numbers, if a jump started with a velocity of -5000, and ended with a velocity of 4800, the next jump will add an impulse of -5000, taking the jump to a starting velocity of only -200. That might have an ending velocity of 300, so the next jump will be an almost full -4700 jump.
Here's a complete working example. It uses the gloss library for input and display. The gameDefinition corresponds to the components introduced in your question. integrateDeltas is equivalent to your integralB, but produces events that are impulses, which are easy to generate in a clocked framework like gloss, and easy to use mixed with other events that cause impulses, like jumping.
{-# LANGUAGE RankNTypes #-}
module Main where
import Reactive.Banana
import Reactive.Banana.Frameworks.AddHandler
import Reactive.Banana.Frameworks
import Data.IORef
import qualified Graphics.Gloss.Interface.IO.Game as Gloss
gameDefinition :: GlossGameEvents t -> Behavior t Gloss.Picture
gameDefinition events = renderBehavior
where
bY = accumB 0 (fmap sumIfPositive yShifts)
yShifts = integrateDeltas bYVel
bYVel = accumB 0 yVelChanges
yVelChanges = apply ((ifB airborne) (+) sumIfPositive) yVelShifts
yVelShifts = union (integrateDeltas bYAccel) (fmap (const 3) eJump)
bYAccel = (ifB airborne) (-10) 0
airborne = fmap (>0) bY
eJump = filterE isKeyEvent (event events)
integrateDeltas = integrateDeltaByTimeStep (timeStep events)
renderBehavior = (liftA3 render) bY bYVel bYAccel
render y yVel yAccel =
Gloss.Pictures [
Gloss.Translate 0 (20+y*100) (Gloss.Circle 20),
Gloss.Translate (-50) (-20) (readableText (show y)),
Gloss.Translate (-50) (-40) (readableText (show yVel)),
Gloss.Translate (-50) (-60) (readableText (show yAccel))
]
readableText = (Gloss.Scale 0.1 0.1) . Gloss.Text
-- Utilities
sumIfPositive :: (Ord n, Num n) => n -> n -> n
sumIfPositive x y = max 0 (x + y)
ifB :: Behavior t Bool -> a -> a -> Behavior t a
ifB boolBehavior yes no = fmap (\bool -> if bool then yes else no) boolBehavior
integrateDeltaByTimeStep :: (Num n) => Event t n -> Behavior t n -> Event t n
integrateDeltaByTimeStep timeStep derivative = apply (fmap (*) derivative) timeStep
isKeyEvent :: Gloss.Event -> Bool
isKeyEvent (Gloss.EventKey _ _ _ _) = True
isKeyEvent _ = False
-- Main loop to run it
main :: IO ()
main = do
reactiveGame (Gloss.InWindow "Reactive Game Example" (400, 400) (10, 10))
Gloss.white
100
gameDefinition
-- Reactive gloss game
data GlossGameEvents t = GlossGameEvents {
event :: Event t Gloss.Event,
timeStep :: Event t Float
}
makeReactiveGameNetwork :: Frameworks t
=> IORef Gloss.Picture
-> AddHandler Gloss.Event
-> AddHandler Float
-> (forall t. GlossGameEvents t -> Behavior t Gloss.Picture)
-> Moment t ()
makeReactiveGameNetwork latestFrame glossEvent glossTime game = do
eventEvent <- fromAddHandler glossEvent
timeStepEvent <- fromAddHandler glossTime
let
events = GlossGameEvents { event = eventEvent, timeStep = timeStepEvent }
pictureBehavior = game events
pictureChanges <- changes pictureBehavior
reactimate (fmap (writeIORef latestFrame) pictureChanges)
reactiveGame :: Gloss.Display
-> Gloss.Color
-> Int
-> (forall t. GlossGameEvents t -> Behavior t Gloss.Picture)
-> IO ()
reactiveGame display color steps game = do
latestFrame <- newIORef Gloss.Blank
(glossEvent, fireGlossEvent) <- newAddHandler
(glossTime, addGlossTime) <- newAddHandler
network <- compile (makeReactiveGameNetwork latestFrame glossEvent glossTime game)
actuate network
Gloss.playIO
display
color
steps
()
(\world -> readIORef latestFrame)
(\event world -> fireGlossEvent event)
(\time world -> addGlossTime time)
In this example, bY checks for collision with a floor at 0 by accumulating the impulses, but constraining the accumulated value to be above 0.
The velocity, bYVel, accumulates all impulses while airborne, but only those impulses that are directed away from the floor while not airborne. If you change
yVelChanges = apply ((ifB airborne) (+) sumIfPositive) yVelShifts
to
yVelChanges = fmap (+) yVelShifts
it recreates the erratic jumping bug.
The acceleration, bYAccel, is only present while airborne.
I used a coordinate system with a +Y axis in the up direction (opposite the acceleration).
The code at the end is a small framework to hook reactive-banana up to gloss.
Solved it! I feel a little silly for not thinking of this earlier, but I just increment a counter every eJump and add that counter on to bYVel.
bJumpVel = sumB $ (-5000) <$ eJump
bYVel = (+) <$> bJumpVel <*> integralB bYAccel
-- gives the sum of the events
sumB :: Num a => Event t a -> Behavior t a
sumB e = accumB 0 $ (+) <$> e
For some reason the height of the jump always varies quite a bit, but that's probably an unrelated problem to do with my timing of things.
I won't mark this question as answered yet in case someone wants to share a better one.
So I'm trying to understand how Sodium's model for functional reactive programming works, and I'm running into some snags.
I have a list of numbers that I'm updating with a "Time" like value, and I'm adding to this list when space characters are passed in.
The engine that runs this is as follows.
import FRP.Sodium
type Time = Event Int
type Key = Event Char
type Game a = Time -> Key -> Reactive (Behavior a)
run :: Show a => Game a -> IO ()
run game = do
(dtEv, dtSink) <- sync newEvent
(keyEv, keySink) <- sync newEvent
g <- sync $ do
game' <- game dtEv keyEv
return game'
go g dtSink keySink
return ()
where
go gameB dtSink keySink = do
sync $ dtSink 1
ks <- getLine
mapM_ (sync . keySink) ks
v <- sync $ sample gameB
print v
go gameB dtSink keySink
So with this I'm printing the current value the game behavior gives every "tick". Here is the code for the game behavior.
main :: IO ()
main = run game
game :: Time -> Key -> Reactive (Behavior [Int])
game dt key = do
let spawn = const 0 <$> filterE (==' ') key
rec
bs <- hold [] $ snapshotWith (\s xs -> (s:xs)) spawn updated
updated <- hold [] $ snapshotWith (\t xs -> map (+t) xs) dt bs
return updated
What I'd expect this to do is with every space character inputted, a 0 gets injected into the list.
Effectively, every time enter is pressed, I'd expect all the numbers in the list to increment by one.
Instead what happens the numbers increment only after I press space.
Does anyone know where I'm going wrong?
After some more thought, it's pretty obvious what the problem was.
The issue with my code is that I have this circular dependence that doesn't take into account the fact that the each behavior also depends on its own changes.
This meant that whenever I tried to add things to the list it'd take the old value of the list given by the time update to change the value, until the time value changed.
To rectify this problem, I restructured the game behavior to merge the update and spawn events like so.
data GEvent = Alter ([Int] -> [Int])
game :: Time -> Key -> Reactive (Behavior [Int])
game dt key = do
let spawn = const (Alter (\xs -> (0:xs))) <$> filterE (==' ') key
update = (\t -> Alter (\xs -> map (+t) xs)) <$> dt
applyAlter (Alter f) xs = f xs
rec
bs <- hold [] $ snapshotWith applyAlter (merge spawn update) bs
return bs
This ensures that when either event occurs that they get the most up to date version of the list.
I'm trying to simulate a bouncing ball with the Yampa-Framework: Given an initial x-position, height and velocity, the ball should bounce according to gravity rules. The signal function takes a "Tip-Event" as input, the idea being "when the ball is tipped, it's speed should double".
The ball bounces nicely, but every time there is a tipping event, the function goes in to an endless loop. I figured I probably need to add a delay (dSwitch, pre, notYet?), but I do not know how. Any help would be appreciated!
{-# LANGUAGE Arrows #-}
module Ball where
import FRP.Yampa
type Position = Double
type Velocity = Double
type Height = Double
data Ball = Ball {
height :: Height,
width :: Position,
vel :: Velocity
} deriving (Show)
type Tip = Event ()
fly :: Position -> (Height, Velocity) -> SF Tip (Ball, Event (Height,Velocity))
fly w0 (h0, v0) = proc tipEvent -> do
let tip = (tipEvent == Event ())
v <- (v0+) ^<< integral -< -10.0
h <- (h0+) ^<< integral -< v
returnA -< (Ball h w0 v,
if h < 0 then Event (0,(-v*0.6))
else if tip then Event (h, (v*2))
else NoEvent)
bounce w (h,v) = switch (fly w (h,v)) (bounce w)
runBounce w (h,v) = embed (bounce 10 (100.0, 10.0)) (deltaEncode 0.1 [NoEvent, NoEvent, NoEvent, Event (), NoEvent])
EDIT: I managed to avoid the endless loop by feeding back a flag when a tip occurred, but that still does not feel like the right way to do it...
fly :: Position -> (Height, Velocity, Bool) -> SF Tip (Ball, Event (Height,Velocity,Bool))
fly w0 (h0, v0, alreadyTipped) = proc tipEvent -> do
let tip = tipEvent == Event () && (not alreadyTipped)
v <- (v0+) ^<< integral -< -10.0
h <- (h0+) ^<< integral -< v
returnA -< (Ball h w0 v,
if h < 0 then Event (0,(-v*0.6), False)
else if tip then Event (h, (v*2), True)
else NoEvent)
bounce w (h,v,alreadyTipped) = switch (fly w (h,v,alreadyTipped)) (bounce w)
After a few days hacking I think I found the answer. The trick is to use notYet to delay the switching event to the next point in time, so that the switching (and hence the recursive call to fly) occurs when the "old" tipping event is gone. The second function makes sure that only the second part of the result tuple (Ball, Event (..)) will be put through notYet. This removes the endless loop, but also changes the semantics: The switching now takes place one "time step" later, this in turn leads to a different speed.
This Yampa thing is actually quite nice, sadly there is not much documentation to find. I still could not find out what the pre and iPre functions are good for, I figure they can be used in a similar context.
fly :: Position -> (Height, Velocity) -> SF Tip (Ball, Event (Height,Velocity))
fly w0 (h0, v0) = proc tipEvent -> do
let tip = tipEvent == Event ()
v <- (v0+) ^<< integral -< -10.0
h <- (h0+) ^<< integral -< v
returnA -< (Ball h w0 v,
if h < 0 then Event (0,-v*0.6)
else if tip then Event (h, v*2)
else NoEvent)
bounce w (h,v) = switch (fly w (h,v) >>> second notYet) (bounce w)
So I'm working on a minimax implementation for a checkers-like game to help myself learn Haskell better. The function I'm having trouble with takes a list for game states, and generates the list of immediate successor game states. Like checkers, if a jump is available, the player must take it. If there's more than one, the player can choose.
For the most part, this works nicely with the list monad: loop over all the input game states, loop over all marbles that could be jumped, loop over all jumps of that marble. This list monad nicely flattens all the lists out into a simple list of states at the end.
The trick is that, if no jumps are found for a given game state, I need to return the current game state, rather than the empty list. The code below is the best way I've come up with of doing that, but it seems really ugly to me. Any suggestions on how to clean it up?
eHex :: Coord -> Coord -- Returns the coordinates immediately to the east on the board
nwHex :: Coord -> Coord -- Returns the coordinates immediately to the northwest on the board
generateJumpsIter :: [ZertzState] -> [ZertzState]
generateJumpsIter states = do
ws <- states
case children ws of
[] -> return ws
n#_ -> n
where
children ws#(ZertzState s1 s2 b p) = do
(c, color) <- occupiedCoords ws
(start, end) <- [(eHex, wHex), (wHex, eHex), (swHex, neHex),
(neHex, swHex), (nwHex, seHex), (seHex, nwHex)]
if (hexOccupied b $ start c) && (hexOpen b $ end c)
then case p of
1 -> return $ ZertzState (scoreMarble s1 color) s2
(jumpMarble (start c) c (end c) b) p
(-1) -> return $ ZertzState s1 (scoreMarble s2 color)
(jumpMarble (start c) c (end c) b) p
else []
EDIT: Provide example type signatures for the *Hex functions.
The trick is that, if no jumps are found for a given game state, I need to return the current game state, rather than the empty list.
Why? I've written minimax several times, and I can't imagine a use for such a function. Wouldn't you be better off with a function of type
nextStates :: [ZertzState] -> [Maybe [ZertzState]]
or
nextStates :: [ZertzState] -> [[ZertzState]]
However if you really want to return "either the list of next states, or if that list is empty, the original state", then the type you want is
nextStates :: [ZertzState] -> [Either ZertzState [ZertzState]]
which you can then flatten easily enough.
As to how to implement, I recommend defining a helper function of type
[ZertzState] -> [(ZertzState, [ZertzState])]
and than you can map
(\(start, succs) -> if null succs then Left start else Right succs)
over the result, plus various other things.
As Fred Brooks said (paraphrasing), once you get the types right, the code practically writes itself.
Don't abuse monads notation for list, it's so heavy for nothing. Moreover you can use list comprehension in the same fashion :
do x <- [1..3]
y <- [2..5] <=> [ x + y | x <- [1..3], y <- [2..5] ]
return x + y
now for the 'simplification'
listOfHex :: [(Coord -> Coord,Coord -> Coord)]
listOfHex = [ (eHex, wHex), (wHex, eHex), (swHex, neHex)
, (neHex, swHex), (nwHex, seHex), (seHex, nwHex)]
generateJumpsIter :: [ZertzState] -> [ZertzState]
generateJumpsIter states =
[if null ws then ws else children ws | ws <- states]
where -- I named it foo because I don t know what it do....
foo True 1 = ZertzState (scoreMarble s1 color) s2
(jumpMarble (start c) c (end c) b) p
foo True (-1) = ZertzState s1 (scoreMarble s2 color)
(jumpMarble (start c) c (end c) b) p
foo False _ = []
foo _ _ = error "Bleh"
children ws#(ZertzState s1 s2 b p) =
[ foo (valid c hex) p | (c, _) <- occupiedCoords ws, hex <- listOfHex ]
where valid c (start, end) =
(hexOccupied b $ start c) && (hexOpen b $ end c)
The let in the let in list commprehension at the top bother me a little, but as I don't have all the code, I don't really know how to do it in an other way. If you can modify more in depth, I suggest you to use more combinators (map, foldr, foldl' etc) as they really reduce code size in my experience.
Note, the code is not tested, and may not compile.