import Data.Array
import Data.Maybe
import Control.Monad
import System.Random

type Pos = (Int, Int)
type OX = Bool
type Board = Array Pos (Maybe OX)
type View = OX -> Bool
type Strategy m = Board -> View -> m Pos
type Player m = (Strategy m, View)

emptyBoard :: Board
emptyBoard = array ((0,0), (2,2)) [(p, Nothing) | p<-ps]
  where ps = [(x,y) | x<-[0..2], y<-[0..2]]

availablePos :: Board -> [Pos]
availablePos b = [p | (p, Nothing) <- assocs b]

win :: Board -> View -> Bool
win b v = any (all (fromMaybe False . fmap v . (b!))) xss
  where
    xss = [ [(x,y) | y<-[0..2]] | x<-[0..2] ] ++
          [ [(x,y) | x<-[0..2]] | y<-[0..2] ] ++
          [ [(0,0), (1,1), (2,2)], [(0,2), (1,1), (2,0)] ]

play :: Monad m => Strategy m -> Strategy m -> m (Maybe Bool)
play s1 s2 = go emptyBoard (s1, id) (s2, not)
  where
    go b p1@(s,v) p2
        | null ps = return Nothing
        | otherwise = do
            pos <- s b v
            let m = Just (v True)
                b' = b // [(pos, m)]
            if win b' v
              then return m
              else go b' p2 p1
      where ps = availablePos b

randStrategy :: Strategy IO
randStrategy b v = do
  let ps = availablePos b
  i <- getStdRandom (randomR (0, length ps - 1))
  when (i<0) $ putStrLn $ show ps
  return (ps!!i)

main :: IO ()
main = do
  let n = 10000
  xs <- replicateM n (play randStrategy randStrategy)
  let a = sum [1 | Just True <- xs]
      b = sum [1 | Just False <- xs]
      c = n - (a + b)
  putStrLn $ "player1 won: " ++ show a
  putStrLn $ "player2 won: " ++ show b
  putStrLn $ "draw: "  ++ show c
  putStrLn $ "total: " ++ show n