Merge branch 'master' of github.com:norm2782/HaskBan

Conflicts:
	HaskBan.hs

.gitignore

@@ -0,0 +1,3 @@
+*.o
+*.hi
+*.swp

HaskBan.hs

@@ -1,45 +1,24 @@
 {-# LANGUAGE NoMonomorphismRestriction, GeneralizedNewtypeDeriving #-}
-module HaskBan where
+module HaskBan (mainAction, jurrenMainAction) where
 
---  import SokoParser (parseSokoMap)
-  import qualified Data.Map as M
-  import Control.Monad.State as MS
-  import Control.Monad (liftM, mapM_)
   import UI.HSCurses.Curses
-
-  data CellType = Wall
-                | Box
-                | Path
-                | Target
-                deriving (Show, Eq, Ord)
-
-  data Surrounding = Left CellType
-                   | Right CellType
-                   | Up CellType
-                   | Down CellType
-                   deriving (Show, Eq, Ord)
+  import HaskBanTypes
+  import HaskBanParser (runHaskBanParser)
+  import HaskBanPrinter 
+  import Control.Monad (mapM_)
+  import qualified Data.ByteString as BS
 
-  type Point = (Int, Int)
-
-  type SokoMap = M.Map Point CellType
-
-  data SokobanStateInfo = SokobanStateInfo {
-    player  :: Point,
-    boxes   :: [Point],
-    targets :: [Point],
-    cellMap :: SokoMap
-  } deriving (Show)
-
-  newtype SokobanState a = SokobanState (MS.State SokobanStateInfo a)
-                           deriving (Monad, MonadState SokobanStateInfo)
-
-  getPlayerPosition :: SokobanState Point
-  getPlayerPosition = player `liftM` get
+  mainAction :: IO ()
+  mainAction = BS.readFile "input.in" >>= \contents ->
+               mapM_ (putStrLn . showCellMatrix) (runHaskBanParser contents)
 
-  putPlayerPosition :: Point -> SokobanState ()
-  putPlayerPosition position = get >>= \state -> put (state {player = position})
-
-  isValidMove 
+  main :: IO ()
+  main = do window <- initScr
+            initCurses
+            mvWAddStr window 0 0 "Welcome to HaskBan, the world's most awesome Haskell-based Sokoban game."
+            move 1 0
+            refresh
+            progLoop
 
   processKey :: Key -> ()
   processKey KeyUp    = undefined
@@ -59,10 +38,3 @@ module HaskBan where
                   else do return (processKey key)
                           progLoop
 
-  main :: IO ()
-  main = do window <- initScr
-            initCurses
-            mvWAddStr window 0 0 "Welcome to HaskBan, the world's most awesome Haskell-based Sokoban game."
-            move 1 0
-            refresh
-            progLoop

HaskBanParser.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
+-- | The Parser will interpret characters the following way:
+-- 1) The test case starts with the string "Level #" where # is the number of the level
+-- 2) The following lines will contain a set of characters that go the following way
+--    # -> Wall
+--    @ -> First position of the player
+--    . -> Target position (pit)
+--    $ -> Box that needs to be put on a pit
+--    * -> Target position with a box on it 
+--
+--  3) The parsing will conclude when you get to the EOF or when the word END is parsed
+--
+-- parseSokoMap
+module HaskBanParser (runHaskBanParser) where
+
+  import HaskBanTypes (CellType(..), CellMatrix, SokoMap)
+  import Data.ByteString (ByteString)
+  import Text.Parsec hiding (many, optional)
+  import Text.Parsec.ByteString
+  import Control.Applicative
+
+  readInt :: String -> Int
+  readInt = read
+  parseInt = readInt <$> (many digit)
+
+  parsePlayer = char '@' *> pure Player
+  parseWall = char '#' *> pure Wall
+  parseBox  = char '$' *> pure Box
+  parsePath = char ' ' *> pure Path
+  parseTarget = char '.' *> pure (Target Nothing)
+  parseRockOnTarget = char '*' *> pure (Target (Just Box))
+
+  parseCellType = choice [parseWall, parseBox, parsePath, parseTarget, parsePlayer, parseRockOnTarget]
+  parseCellTypeRow = many parseCellType <* char '\n'
+  parseCellMatrix = string "Level " *> parseInt *> spaces *> (many parseCellTypeRow)
+  parseEndSection = spaces *> string "END"
+  parseHaskBan = many parseCellMatrix <* optional parseEndSection
+
+  runHaskBanParser :: ByteString -> [CellMatrix]
+  runHaskBanParser input = 
+    case parse parseHaskBan "()" input of
+      Left e -> error (show e)
+      Right celltypes -> celltypes
+
+  {--
+  validCellTypeMatrix :: [[CellType]] -> Maybe [[CellType]]
+  validCellTypeMatrix [] = Just []
+  validCellTypeMatrix matrix@(x:xs) = if isValid then Just matrix else Nothing
+    where
+      lx = length x
+      isValid = all id (map ((lx==) . length xs))
+
+  cellTypeMatrixToSokoMap :: [[CellType]] -> SokoMap
+  cellTypeMatrixToSokoMap xs = helper 0 xs
+    where
+      helper i xs
+  --}
+
+

HaskBanPrinter.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+module HaskBanPrinter where
+
+  import HaskBanTypes (CellType(..), CellMatrix)
+  import Data.List (intercalate, intersperse)
+
+  instance Show CellType where
+    show Wall = "#"
+    show Player = "λ"
+    show Box = "$"
+    show Path = " "
+    show (Target (Nothing)) = "."
+    show (Target (Just _)) = "*"
+    show Empty = " "
+
+  showCellMatrix :: CellMatrix -> String
+  showCellMatrix = intercalate "\n" . map (concat . (map show))
+
+
+

HaskBanTypes.hs

@@ -0,0 +1,41 @@
+module HaskBanTypes where
+  import qualified Data.Map as M
+
+  data CellType = Wall
+                | Player
+                | Box
+                | Path
+                | Target (Maybe CellType) -- target could have a box on the initial state
+                | Empty -- for spaces that don't mean anything on the map (see input)
+                deriving (Eq, Ord)
+
+  data Surrounding = Left CellType
+                   | Right CellType
+                   | Up CellType
+                   | Down CellType
+                   deriving (Eq, Ord)
+
+  type CellMatrix = [[CellType]]
+
+  type Point = (Int, Int)
+
+  type SokoMap = M.Map Point CellType
+
+  data SokobanState = SokobanState {
+    player :: Point,
+    boxes :: [Point],
+    targets :: [Point],
+    cellMap :: SokoMap
+  }
+
+  -- QUESTION: on it's own Module?
+  newtype SokobanState a = SokobanState (MS.State SokobanStateInfo a)
+                           deriving (Monad, MonadState SokobanStateInfo)
+
+  getPlayerPosition :: SokobanState Point
+  getPlayerPosition = player `liftM` get
+
+  putPlayerPosition :: Point -> SokobanState ()
+  putPlayerPosition position = get >>= \state -> put (state {player = position})
+
+

Main.hs

@@ -0,0 +1,7 @@
+module Main where
+
+  import HaskBan (mainAction, jurrenMainAction)
+
+  main = jurrenMainAction
+
+

README

@@ -1 +1,6 @@
 Sokoban clone implemented in Haskell. Developed in the context of H9: Applied Functional Programming at Utrecht Summerschool 2010.
+
+Link for input test cases: http://webdocs.cs.ualberta.ca/~games/Sokoban/status.html
+
+Dependencies:
+  * hscurses