# Sokoban text clone

I rewrote this simple, list-based Sokoban implementation a few times, trying to make it better. Right now, I'm stuck without ideas, but I still feel there is room for improvement, specially in runLoop and data types.

Is there anything, such as monad transformers, FRP, lenses, or anything else that I should study to be able to improve it?

module Main where

import Data.Char
import Data.List
import Data.Maybe
import Linear.V2
import System.IO

type Tile = Char
type Level = [[Tile]]
type Position  = V2 Int
type Direction = V2 Int

up    = V2   0 (-1)
down  = V2   0   1
left  = V2 (-1)  0
right = V2   1   0

sampleLevel =   "############  \n\
\#..  #     ###\n\
\#..  #   #\n\
\#..  #$#### #\n\ \#.. @ ## #\n\ \#.. # #$ ##\n\
\###### ## #\n\
\  #   #\n\
\  #    #     #\n\
\  ############\n"

main = do
initialize
runLoop $readLevel sampleLevel return () initialize :: IO () initialize = do hSetEcho stdin False hSetBuffering stdin NoBuffering readLevel :: String -> Level readLevel = lines showLevel :: Level -> IO () showLevel = putStrLn . unlines runLoop :: Level -> IO Level runLoop level = do showLevel level if isFinished level then do putStrLn "Congratulations!" return level else do command <- iterateUntil (elem "WASDX")$ toUpper <$> getChar case command of 'W' -> runLoop$ tryMove level $up 'A' -> runLoop$ tryMove level $left 'S' -> runLoop$ tryMove level $down 'D' -> runLoop$ tryMove level $right 'X' -> return level isFinished :: Level -> Bool isFinished = isNothing . findIndex (elem ".+") . concat tryMove :: Level -> Direction -> Level tryMove level direction = foldl setTile level$ zip positions updatedTiles
where
updatedTiles = case getTile level <$> positions of ['@',' ', _ ] -> " @" ['@','.', _ ] -> " +" ['+',' ', _ ] -> ".@" ['+','.', _ ] -> ".+" ['@','$',' '] -> " @$" ['@','$','.'] -> " @*"
['@','*',' '] -> " +$" ['@','*','.'] -> " +*" ['+','$',' '] -> ".@$" ['+','$','.'] -> ".@*"
['+','*',' '] -> ".+\$"
['+','*','.'] -> ".+*"
otherwise     -> ""
positions = [pusherPosition level + direction * pure x | x <-[0..2]]

pusherPosition :: Level -> Position
pusherPosition xss = head [ V2 x y
| (y, line) <- zip [0..] xss
, (x, tile) <- zip [0..] line
, tile elem "@+" ]

getTile :: Level -> Position -> Tile
getTile xss (V2 x y) = xss !! y !! x

setTile :: Level -> (Position,Tile) -> Level
setTile xss (V2 x y, tile) = adjust (update tile x) y xss

adjust :: (a -> a) -> Int -> [a] -> [a]
adjust f index xs = take index xs ++ f (xs !! index) : drop (index + 1) xs

update :: a -> Int -> [a] -> [a]
update value index xs = adjust (const value) index xs

• I think a more substantial code base would warrant further refactorings — trying to improve this one is just artificial, I'd say. it looks good as is. Oct 29, 2015 at 13:30

Lens: ix y . ix x can replace your last four definitions.
Why does runLoop return IO Level as opposed to IO () when you never use the Level?
I would inline readLevel, or do you plan to make it more complicated in later versions?
I would change tryMove's type signature into Direction -> Level -> Level.
• I will study lens to try your first idea Thanks! runLoop has type Level -> IO Level because it's called with the results from tryMove. readLevel and showLevel were not inlined because at thought it would be clearer and easier to maintain that way, but I understand that this costs a few lines of code. :-) I agree with you about tryMove's type signature. Seems to make sense - as a general rule - to put the transformation before the data, but I never stopped to think about it before. Nov 5, 2015 at 19:04
• runLoop could be Level -> IO () because the caller of runLoop never uses the level it returned, neither main nor runLoop itself after recursive calls. Mar 13, 2016 at 23:35