6
\$\begingroup\$

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 Control.Monad.Loops
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
\$\endgroup\$
1
  • 2
    \$\begingroup\$ 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. \$\endgroup\$ Oct 29 '15 at 13:30
2
\$\begingroup\$

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.

\$\endgroup\$
2
  • \$\begingroup\$ 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. \$\endgroup\$
    – rbasso
    Nov 5 '15 at 19:04
  • \$\begingroup\$ runLoop could be Level -> IO () because the caller of runLoop never uses the level it returned, neither main nor runLoop itself after recursive calls. \$\endgroup\$
    – Gurkenglas
    Mar 13 '16 at 23:35

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.