initial commit

.gitignore

@@ -0,0 +1,15 @@
+dist
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp

Board.hs

@@ -0,0 +1,66 @@
+module Board
+  ( Board
+  , Piece(..)
+  , Position
+  , isWon
+  , emptyBoard
+  , showBoard
+  , updateBoard
+  , canPlace
+  , change
+  , isFull
+  ) where
+
+import Data.Maybe (isJust)
+import Data.List (intercalate, intersperse, transpose)
+import Data.List.Split (chunksOf)
+
+data Piece = X | O deriving (Eq, Show, Ord)
+
+change :: Piece -> Piece
+change X = O
+change O = X
+
+{-
+ 1 | 2 | 3
+---+---+---
+ 4 | 5 | 6
+---+---+---
+ 7 | 8 | 9
+-}
+type Position = Int
+type Board = [Maybe Piece]
+
+showBoard :: Board -> String
+showBoard =
+  unlines .
+  intersperse "---+---+---" .
+  map (intercalate "|") .
+  chunksOf 3 .
+  map (\p -> " " ++ maybe " " show p ++ " ")
+
+emptyBoard :: Board
+emptyBoard = replicate 9 Nothing
+
+sampleBoard :: Board
+sampleBoard = take 9 $ cycle [Nothing, Just X, Just O, Nothing]
+
+isFull :: Board -> Bool
+isFull = all isJust
+
+isWon :: Board -> Bool
+isWon b = any full $ rows ++ cols ++ diagonals
+  where
+    full ps@[p1,p2,p3] = all isJust ps && p1 == p2 && p2 == p3
+    rows               = chunksOf 3 b
+    cols               = transpose rows
+    diagonals          = map (map (b !!)) [[0,4,8], [2,4,6]]
+
+isFinished :: Board -> Bool
+isFinished board = isFull board || isWon board
+
+updateBoard :: Position -> Piece -> Board -> Board
+updateBoard position piece board = take (position - 1) board ++ [Just piece] ++ drop position board
+
+canPlace :: Position -> Board -> Bool
+canPlace position board = not $ isJust $ board !! (position - 1)

LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2015 TANIGUCHI Kohei
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

Main.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
+module Main where
+
+import Control.Monad.Random
+import Control.Monad.State
+
+import Board
+import Player
+
+main :: IO ()
+main = evalStateT (game human ai) initialGameState
+  where
+    -- ai = serialAI
+    ai = randomAI
+    -- ai = human
+
+
+data GameState = GameState { board :: Board, active :: Piece }
+
+initialGameState :: GameState
+initialGameState = GameState emptyBoard X
+
+-- type Winner = Piece
+-- game :: (MonadState GameState m) => Player m -> Player m -> m Winner
+-- game :: (MonadState GameState m, MonadWriter [Board] m) => Player m -> Player m -> m Winner
+game :: (MonadState GameState m) => Player m -> Player m -> m ()
+game p1 p2 = do
+  board <- gets board
+  pos <- p1 board
+  if not $ canPlace pos board
+    then game p1 p2
+    else do
+      piece <- gets active
+      let board' = updateBoard pos piece board
+      modify $ \s -> GameState { board = board', active = change piece }
+      if isFull board' || isWon board'
+        then return ()
+        else game p2 p1

Player.hs

@@ -0,0 +1,30 @@
+module Player where
+
+import Control.Monad.Random
+import Control.Monad.State
+import System.IO (hFlush, stdout)
+
+import Board
+
+type Player m = Board -> m Position
+-- type Player m = Piece -> Board -> m Position  -- know which turn
+
+human :: MonadIO m => Player m
+human board = liftIO $ do
+  putStr $ showBoard board
+  putStr "Input hand: "
+  hFlush stdout  -- force `putStr` before `readLn`
+  readLn
+
+randomAI :: MonadRandom m => Player m
+randomAI _board = getRandomR (1,9)
+
+serialAI :: Monad m => Player m
+serialAI board = evalStateT serialAI' (cycle [1..9])
+  where
+    serialAI' = do
+      i:is <- get
+      put is
+      if canPlace i board
+        then return i
+        else serialAI'

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

ttt.cabal

@@ -0,0 +1,70 @@
+-- The name of the package.
+name:                ttt
+
+-- The package version.  See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- http://www.haskell.org/haskellwiki/Package_versioning_policy
+-- PVP summary:      +-+------- breaking API changes
+--                   | | +----- non-breaking API additions
+--                   | | | +--- code changes with no API change
+version:             0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis:            Tic Tac Toe AI
+
+-- A longer description of the package.
+-- description:
+
+-- The license under which the package is released.
+license:             MIT
+
+-- The file containing the license text.
+license-file:        LICENSE
+
+-- The package author(s).
+author:              TANIGUCHI Kohei
+
+-- An email address to which users can send suggestions, bug reports, and
+-- patches.
+maintainer:          [email protected]
+
+-- A copyright notice.
+-- copyright:
+
+category:            Game
+
+build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or a
+-- README.
+-- extra-source-files:
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version:       >=1.10
+
+
+executable ttt
+  -- .hs or .lhs file containing the Main module.
+  main-is:             Main.hs
+
+  -- Modules included in this executable, other than Main.
+  other-modules:
+      Board
+    , Player
+
+
+  -- LANGUAGE extensions used by modules in this package.
+  -- other-extensions:
+
+  -- Other library packages from which modules are imported.
+  build-depends:       MonadRandom >= 0.3.0.2
+                     , base >=4.8 && <4.9
+                     , monad-skeleton >= 0.1.1
+                     , mtl >= 2.2.1
+                     , split >= 0.2.2
+
+  -- Directories containing source files.
+  -- hs-source-dirs:
+
+  -- Base language which the package is written in.
+  default-language:    Haskell2010