finished MonadicGame.hs

src/MonadicGame.hs

@@ -1,13 +1,13 @@
 {-# OPTIONS -Wall #-}
-module MonadicGame(executeGame, move, moves, readScore, readNote) where
+module MonadicGame(executeGame, move, moves, readScore, readNote, getBestMovesFromHere, saveGame, loadGame, deleteSavedGame, deleteAllSaved, loadFromGame, executeStepCommands, retrieveGameData) where
 
 import Control.Applicative
+import qualified Data.HashMap as M
+import Data.Maybe
 import Datatypes.Game
 import VM
 
-
-
-data MonadicGameInternal = MonadicGameInternal { igame :: Game , inote :: Notes}
+data MonadicGameInternal = MonadicGameInternal { igame :: Game , inote :: Notes, isaves :: M.Map String (Game,Notes) }
 
 data MonadicGame a = MonadicAction {action :: (MonadicGameInternal -> (MonadicGameInternal, a))}
 
@@ -50,22 +50,40 @@ readGame readFunction = modifyGame (\_ x -> (x, readFunction x)) ()
 writeGame :: (a -> MonadicGameInternal -> MonadicGameInternal) -> a -> MonadicGame ()
 writeGame writeFunction = modifyGame (\x y -> (writeFunction x y, ()))
 
------- Public Functions -----
+-----------------------------
+
 
+------ Public Functions -----
 
--- Apply the monad to a Game
+-- Apply the monad to a Game, return the list of command to execute and the score
 executeGame :: Game -> MonadicGame () -> ([Command], Int)
-executeGame game (MonadicAction finalFunction) =  (history executedGame, score executedGame)
+executeGame game (MonadicAction actions) =  (history executedGame, score executedGame)
   where
-    executedGame = (igame . fst . finalFunction) (MonadicGameInternal{igame = game, inote = OK})
+    executedGame = (igame . fst . actions) (MonadicGameInternal{igame = game, inote = OK, isaves = M.empty})
 
+loadFromGame :: Game -> MonadicGameInternal
+loadFromGame game = (MonadicGameInternal{igame = game, inote = OK, isaves = M.empty})
+
+executeStepCommands :: MonadicGame () -> MonadicGameInternal -> MonadicGameInternal
+executeStepCommands (MonadicAction actions) game = newGame
+  where
+    newGame = (fst . actions) game
+
+retrieveGameData :: MonadicGameInternal -> ([Command],Int)
+retrieveGameData game = bestData
+  where
+    bestData = M.fold findBestFun initData (isaves  game)
+    initData = ((history . igame) game, (score . igame) game)
+    findBestFun procEl (bestHist,bestScore) = if bestScore > (score . fst) procEl
+                                              then (bestHist,bestScore)
+                                              else (bestHist,bestScore)
 -- Execute a command
 move :: Command -> MonadicGame ()
 move command = writeGame applyMove command
   where
     applyMove param oldGameInternal = newInternals
       where
-        newInternals = MonadicGameInternal {igame = newIgame, inote = newInote}
+        newInternals = oldGameInternal{igame = newIgame, inote = newInote}
         newIgame = fst $ step (igame oldGameInternal) param
         newInote = snd $ step (igame oldGameInternal) param
 
@@ -81,4 +99,57 @@ readScore = readGame (score . igame)
 readNote :: MonadicGame Notes
 readNote = readGame inote
 
+getBestMovesFromHere :: [MonadicGame ()] -> MonadicGame ()
+getBestMovesFromHere [] = return ()
+getBestMovesFromHere movesArr = writeGame bestGameFun movesArr
+  where
+    bestGameFun param oldGameInternal = bestBranch
+      where
+        bestBranch = foldl maxBranch oldGameInternal gameBranches
+        gameBranches = map (\x -> (fst . (action x)) oldGameInternal) param 
+        maxBranch oldMax actualBranch = if (score . igame $ oldMax) > (score . igame $ actualBranch)
+                                        then oldMax
+                                        else actualBranch
+
+saveGame :: String -> MonadicGame ()
+saveGame saveStr = writeGame saveGameFun saveStr
+  where
+    saveGameFun param oldGameInternal = savedGameInternal
+      where
+        savedGameInternal = oldGameInternal{isaves = (M.insert param (actualIgame,actualNote) actualIsaves)}
+        actualIsaves = isaves oldGameInternal
+        actualIgame  = igame oldGameInternal
+        actualNote   = inote oldGameInternal
+        
+loadGame :: String -> MonadicGame Bool
+loadGame loadStr = modifyGame loadGameFun loadStr
+  where
+    loadGameFun param oldGameInternal = (loadedGameInternal, loaded)
+      where
+        lookupResult = M.lookup param (isaves oldGameInternal)
+        (loadedGame, loadedNote, loaded) = if isJust lookupResult
+                                           then (fst $ fromJust lookupResult,snd $ fromJust lookupResult, True) 
+                                           else (igame oldGameInternal, inote oldGameInternal, False)
+        loadedGameInternal = oldGameInternal{igame = loadedGame, inote = loadedNote}
+        
+
+deleteSavedGame :: String -> MonadicGame Bool
+deleteSavedGame delStr = modifyGame deleteSavedGameFun delStr
+  where
+    deleteSavedGameFun param oldGameInternal = (deletedSavedGameInternal, deleted)
+      where
+        oldGameISaved = isaves oldGameInternal
+        deleted = M.member param oldGameISaved 
+        deletedSavedGameInternal = if deleted
+                                   then oldGameInternal{isaves = (M.delete param oldGameISaved)}
+                                   else oldGameInternal
+
+
+deleteAllSaved :: MonadicGame ()
+deleteAllSaved = writeGame deleteAllSavedGameFun ()
+  where
+    deleteAllSavedGameFun _ oldGameInternal = deletedAllSavedGameInternal
+      where
+        deletedAllSavedGameInternal = oldGameInternal{isaves = M.empty}
+
 -----------------------------