Tree.hs

module Tak.Tree (
    GameBranch(..),
    GameNode(..),
    Eval,
    gameTree,
    treeGameState
) where

import Control.Monad.ST

import Tak.ApplyPlay
import Tak.PossiblePlays
import Tak.Types

data GameBranch a = GameBranch Play (GameNode a)
data GameNode a = GameNode GameState a [GameBranch a]

type Eval a = GameState -> a

--hashtableSize :: Integer
--hashtableSize = 10 * 1024 * 1024

gameTree :: GameState -> Eval a -> GameNode a
gameTree gameState eval = runST $ do
    --refAge <- newSTRef 0
    --hashtable <- H.newSized (fromIntegral hashtableSize)
    return $ gameTreeST gameState eval

gameTreeST
    :: GameState
    -> Eval a
    -> (GameNode a)
gameTreeST gameState eval =
    GameNode gameState (eval gameState) branches where
        branches = map branch plays
        branch p =
            let newGameState = noErr $ play p gameState in
            GameBranch p (gameTreeST newGameState eval)
            {-unsafePerformST $ do
                mBranch <- H.lookup table newGameState
                age <- readSTRef refAge
                case mBranch of
                    Nothing -> do
                        let node = gameTreeST newGameState eval refAge table
                            branch = GameBranch p node
                        H.insert table newGameState (age, branch)
                        writeSTRef refAge (age + 1)
                        if (age `mod` 100000 == 0)
                            then (flip H.mapM_) table $ \ (k, (age', v)) -> do
                                if (age' < age - hashtableSize)
                                    then H.delete table k
                                    else return ()
                            else return ()
                        return branch
                    Just (age', branch) -> do
                        H.insert table newGameState (age, branch)
                        return branch-}
        noErr (Left state) = state
        noErr (Right err) = error $ "Error creating game tree: " ++ show err
        plays = possiblePlays gameState

treeGameState :: GameNode a -> GameState
treeGameState (GameNode state _ _) = state