Rewrite of Sokoban using State

Question

I watched this live coding of Sokoban in Haskell and thought I'd take a crack at writing it using State and lenses, since I've never tried that before. My problem is that the control flow seems to be complicated by isWall and friends now being monadic values that I need to unwrap, so I can't use the otherwise obvious approach of guards etc. Any suggestions? I did not focus very much on not making partial functions or handling IO properly, what interests me is how to manage the data and control flow cleanly. Note that I should have also not set default values for _wWorker and _wMax.

The worst culprits are move, toChar and setMaxCoords.

EDIT: Because of the way values are in State, I have a series of functions:

isWall :: MonadState World m => Coord -> m Bool
isWall    c = use $ wWalls.contains c

isCrate :: MonadState World m => Coord -> m Bool
isCrate   c = use $ wCrates.contains c 

isStorage :: MonadState World m => Coord -> m Bool
isStorage c = use $ wStorage.contains c

isWorker :: MonadState World m => Coord -> m Bool
isWorker  c = uses wWorker (==c)

These, I feel, are all fine, but they end up being less than useful in practice, because of the fact that the Bool is wrapped. The unwrapping process becomes very tedious in several functions:

move :: MonadState World m => Direction -> m ()
move dir = do
    newCoord  <- uses wWorker (moveCoord dir)
    let newCoord' = moveCoord dir newCoord
    wall      <- isWall  newCoord
    wall'     <- isWall  newCoord'
    crate     <- isCrate newCoord 

    case () of
        () | wall  -> return ()
           | crate -> if wall' then return () else
                        do
                            wWorker ^= newCoord
                            wCrates %= delete newCoord
                            wCrates %= insert newCoord'
           | otherwise -> wWorker ^= newCoord

toChar :: MonadState World m => Coord -> m Char
toChar c = do
    wall    <- isWall    c
    crate   <- isCrate   c
    storage <- isStorage c
    worker  <- isWorker  c
    return $ case () of
        () | wall      -> '#'
           | worker    -> '@'
           | crate     -> 'o'
           | storage   -> '.'
           | otherwise -> ' '

The lenses themself also come with a certain cost

setMaxCoords :: StateT World IO ()
setMaxCoords = do
    xMaxWall           <- uses wWalls   $ fold (max . fst) 0   
    yMaxWall           <- uses wWalls   $ fold (max . snd) 0   
    xMaxCrate          <- uses wCrates  $ fold (max . fst) 0  
    yMaxCrate          <- uses wCrates  $ fold (max . snd) 0  
    xMaxStorage        <- uses wStorage $ fold (max . fst) 0 
    yMaxStorage        <- uses wStorage $ fold (max . snd) 0 
    (xWorker, yWorker) <- use wWorker                        
    wMax ^= (
        maximum [xMaxWall, xMaxCrate, xMaxStorage, xWorker],
        maximum [yMaxWall, yMaxCrate, yMaxStorage, yWorker]
            )

I feel like I must be missing some obvious abstractions, because all these operations seem trivial and necessary, but the wrapping adds a lot of boilerplate.

The full code is here: http://hpaste.org/73124

Answer 1

I think the is* functions are a bad idea - Haskell has pattern matching for this.

Also you can 'unwrap' your World when necessary and get unwrapped data from it.

data Cell = Wall | Crate | Storage | Worker | Empty

cellContents coords world = bar where
    f x = S.member coords (x ^$ world)
    bar | f wCrates = Crate
        | f wWalls = Wall
        | f wStorage = Storage
        | coords == (wWorker ^$ world) = Worker
        | otherwise = Empty

With this approach toChar can be just

toChar :: World -> Coord -> Char

toChar2 coords world = case cellContents coords world of
      Wall      -> '#'
      Worker    -> '@'
      Crate     -> 'o'
      Storage   -> '.'
      _ -> ' '

If you have already unpacked current world, you can use

let char = toChar2 coords world

If you don't have world you can just do

char <- toChar2 coord <$> get

The only place where you use toChar is printWorld, so it becomes simpler (no need for evalState):

let out = [[ toChar2 (x,y) w | x <- [0 .. maxX]] | y <- [0 .. maxY]]

setMaxCoords can be rewritten as:

setMaxCoords :: StateT World IO ()
setMaxCoords = do
    w <- get
    wMax .= maxCoords w

maxCoords = foldr (app2 max) (0, 0) . allCoords where
    allCoords w = (wWorker ^$ w) : concatMap (\x -> S.toList $ x ^$ w) [ wWalls, wCrates, wStorage ] where
    app2 f (x1, y1) (x2, y2) = (f x1 x2, f y1 y2)

move can be rewritten the same way as toChar2:

move dir w = move2 (cellContents newCoord w) (cellContents newCoord' w) where
    oldCoord = wWorker ^$ w
    newCoord = moveCoord dir oldCoord
    newCoord' = moveCoord dir newCoord

    move2 Wall _ = return ()
    move2 Crate Wall = return ()
    move2 Crate _ = do
        wWorker .= newCoord
        wCrates %= delete newCoord
        wCrates %= insert newCoord'
    move2 _ _ = wWorker .= newCoord

It should be used in the loop as get >>= move dir.