Some code documentation.

refs #1.

Author: portnov

src/Core/Board.hs

@@ -595,13 +595,6 @@ parseBoardKey rules bk = foldr set (buildBoard orient bsize) list
            [(lbl, Piece King Second) | lbl <- labelSetToList (bkSecondKings bk)]
     set (label, piece) board = setPiece' label piece board
 
-boardLineCounts :: Board -> BoardLineCounts
-boardLineCounts board =
-  let (nrows,ncols) = bSize board
-      go row = fromIntegral $ length [col | col <- [0..ncols-1], not (isFree' (Label col row) board)]
-      counts = map go [0..nrows-1]
-  in  BoardLineCounts $ counts ++ replicate (16 - fromIntegral nrows) 0
-
 -- | Generic implementation of @getGameResult@, which suits most rules.
 -- This can not, however, recognize draws.
 genericGameResult :: GameRules rules => rules -> Board -> Maybe GameResult

src/Core/Game.hs

@@ -1,6 +1,15 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ExistentialQuantification #-}
 
+{- 
+ - Game is a record for interaction between two players.
+ - It is created in New status, and there are no players in the game at that moment.
+ - Then two players are attached to the game (in any order). Each player can be a 
+ - human user or an AI (NB: having two AI players in one game is not supported
+ - currently by Supervisor).
+ - After both players are attached, the game can be switched to Running state.
+ -}
+
 module Core.Game where
 
 import Control.Monad.State
@@ -9,10 +18,10 @@ import Control.Monad.Except
 import Core.Types
 import Core.Board
 
--- import Debug.Trace
-
+-- | A monad to track game's state
 type GameM a = ExceptT Error (State Game) a
 
+-- | Initialize Game instance
 mkGame :: GameRules rules => rules -> Int -> Maybe BoardRep -> Game
 mkGame rules id mbBoardRep =
     let board = case mbBoardRep of
@@ -30,21 +39,25 @@ mkGame rules id mbBoardRep =
           gMsgbox2 = []
         }
 
+-- | get currently possible moves in this game
 gamePossibleMoves :: GameM [Move]
 gamePossibleMoves = do
   SomeRules rules <- gets gRules
   board <- gets (gsCurrentBoard . gState)
   currentSide <- gets (gsSide . gState)
   return $ map pmMove $ possibleMoves rules currentSide board
 
+-- | get current state of the game
 gameState :: GameM (Side, GameStatus, Board)
 gameState = do
   st <- gets gState
   status <- gets gStatus
   return (gsSide st, status, gsCurrentBoard st)
 
+-- | Move result. Contains resulting board and a list of notification messages.
 data GMoveRs = GMoveRs Board [Notify]
 
+-- | Perform specified move
 doMoveRq :: Side -> Move -> GameM GMoveRs
 doMoveRq side move = do
   currentSide <- gets (gsSide . gState)
@@ -70,6 +83,7 @@ doMoveRq side move = do
                   _ -> return ()
                 return $ GMoveRs board' messages
 
+-- | Perform specified move, parsing it from MoveRep
 doMoveRepRq :: Side -> MoveRep -> GameM GMoveRs
 doMoveRepRq side mRep = do
   SomeRules rules <- gets gRules
@@ -79,8 +93,10 @@ doMoveRepRq side mRep = do
     AmbigousMove moves -> throwError $ AmbigousMoveError $ map (moveRep rules side . pmMove) moves
     Parsed move -> doMoveRq side move
 
+-- | Undo result
 data GUndoRs = GUndoRs Board [Notify]
 
+-- | Execute undo
 doUndoRq :: Side -> GameM GUndoRs
 doUndoRq side = do
   currentSide <- gets (gsSide . gState)

src/Core/Json.hs

@@ -127,6 +127,6 @@ instance ToJSON RsPayload where
   toJSON (LobbyRs games) = toJSON games
   toJSON (NotationRs size list) = object ["size" .= size, "notation" .= list]
 
-instance ToJSON SupervisorRs where
-  toJSON (SupervisorRs payload messages) = object ["response" .= payload, "messages" .= messages]
+instance ToJSON Response where
+  toJSON (Response payload messages) = object ["response" .= payload, "messages" .= messages]
 

src/Core/Rest.hs

@@ -72,7 +72,7 @@ restServer = do
           Right board -> do
             gameId <- liftCheckers $ newGame rules board
             liftCheckers $ $info "Created new game #{} with board: {}" (gameId, show board)
-            json $ SupervisorRs (NewGameRs gameId) []
+            json $ Response (NewGameRs gameId) []
 
   post "/game/:id/attach/ai/:side" $ do
     gameId <- param "id"
@@ -85,24 +85,24 @@ restServer = do
         liftCheckers $ $info "Attached AI: {} to game #{}" (show ai, gameId)
         liftCheckers $ initAiStorage rules ai
         liftCheckers $ attachAi gameId side ai
-        json $ SupervisorRs AttachAiRs []
+        json $ Response AttachAiRs []
 
   post "/game/:id/attach/:name/:side" $ do
     gameId <- param "id"
     name <- param "name"
     side <- param "side"
     liftCheckers $ registerUser gameId side name
-    json $ SupervisorRs RegisterUserRs []
+    json $ Response RegisterUserRs []
 
   post "/game/:id/run" $ do
     gameId <- param "id"
     liftCheckers $ runGame gameId
-    json $ SupervisorRs RunGameRs []
+    json $ Response RunGameRs []
 
   get "/game/:id/state" $ do
     gameId <- param "id"
     rs <- liftCheckers $ getState gameId
-    json $ SupervisorRs rs []
+    json $ Response rs []
 
   get "/game/:id/fen" $ do
     gameId <- param "id"
@@ -120,41 +120,41 @@ restServer = do
     moveRq <- jsonData
     board <- liftCheckers $ doMove gameId name moveRq
     messages <- liftCheckers $ getMessages name
-    json $ SupervisorRs (MoveRs board) messages
+    json $ Response (MoveRs board) messages
 
   get "/game/:id/moves/:name" $ do
     gameId <- param "id"
     name <- param "name"
     side <- liftCheckers $ getSideByUser gameId name
     moves <- liftCheckers $ getPossibleMoves gameId side
     messages <- liftCheckers $ getMessages name
-    json $ SupervisorRs (PossibleMovesRs moves) messages
+    json $ Response (PossibleMovesRs moves) messages
 
   post "/game/:id/undo/:name" $ do
     gameId <- param "id"
     name <- param "name"
     board <- liftCheckers $ doUndo gameId name
     messages <- liftCheckers $ getMessages name
-    json $ SupervisorRs (UndoRs board) messages
+    json $ Response (UndoRs board) messages
 
   get "/poll/:name" $ do
     name <- param "name"
     messages <- liftCheckers $ getMessages name
-    json $ SupervisorRs (PollRs messages) []
+    json $ Response (PollRs messages) []
 
   get "/lobby/:rules" $ do
     rules <- param "rules"
     games <- liftCheckers $ getGames (Just rules)
-    json $ SupervisorRs (LobbyRs games) []
+    json $ Response (LobbyRs games) []
 
   get "/lobby" $ do
     games <- liftCheckers $ getGames Nothing
-    json $ SupervisorRs (LobbyRs games) []
+    json $ Response (LobbyRs games) []
 
   get "/notation/:rules" $ do
     rules <- param "rules"
     (size, notation) <- liftCheckers $ getNotation rules
-    json $ SupervisorRs (NotationRs size notation) []
+    json $ Response (NotationRs size notation) []
 
 runRestServer :: Checkers ()
 runRestServer = do