packages feed

TicTacToe (empty) → 0.0.1

raw patch · 15 files changed

+1099/−0 lines, 15 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, containers, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

+ Data/TicTacToe.hs view
@@ -0,0 +1,14 @@+module Data.TicTacToe+(+  module Data.TicTacToe.Board+, module Data.TicTacToe.Position+, module Data.TicTacToe.Player+, module Data.TicTacToe.GameResult+, module Data.TicTacToe.Interact+) where++import Data.TicTacToe.Board+import Data.TicTacToe.Position+import Data.TicTacToe.Player+import Data.TicTacToe.GameResult+import Data.TicTacToe.Interact
+ Data/TicTacToe/Board.hs view
@@ -0,0 +1,407 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}++-- | A tic-tac-toe board is one of nine positions, each position occupied by either player 1, player 2 or neither and with invariants specific to the rules of tic-tac-toe.+--+-- For example, the number of positions occupied by player 1 is equal to, or one more, than the positions occupied by player 2.+module Data.TicTacToe.Board+(+-- * Board data types+  EmptyBoard+, Board+, FinishedBoard+-- * Start new game+, empty+-- * Game completed+, getResult+-- * Make a move on a board+, Move(..)+, (-?->)+, MoveResult+, foldMoveResult+, keepPlayingOr+, keepPlaying+-- * Taking a move back from a board+, TakeBack(..)+, TakenBack+, foldTakenBack+, takenBackBoard+-- * Operations common to boards in-play and completed+, BoardLike(..)+-- * Debugging+, printEachPosition+) where++import Prelude hiding (any, all, concat, foldr)+import Data.TicTacToe.Position+import Data.TicTacToe.Player+import Data.TicTacToe.GameResult+import qualified Data.Map as M+import qualified Data.Set as S+import Data.Foldable+import Data.List(intercalate)+import Data.Maybe++data EmptyBoard =+  EmptyBoard++class Move from to | from -> to where+  (-->) ::+    Position+    -> from+    -> to++infixr 5 -->++instance Move EmptyBoard Board where+  p --> _ =+    [(p, player1)] `Board` M.singleton p player1++instance Move Board MoveResult where+  p --> b@(Board q m) =+    let w       = whoseTurn b+        (j, m') = M.insertLookupWithKey (\_ x _ -> x) p w m+        wins =+          [+            (NW, W , SW)+          , (N , C , S )+          , (NE, E , SE)+          , (NW, N , NE)+          , (W , C , E )+          , (SW, S , SE)+          , (NW, C , SE)+          , (SW, C , NE)+          ]+        allEq (d:e:t) = d == e && allEq (e:t)+        allEq _       = True+        isWin         = any (\(a, b, c) -> any allEq $ mapM (`M.lookup` m') [a, b, c]) wins+        isDraw        = all (`M.member` m') [minBound ..]+        b'            = Board ((p, w):q) m'+    in maybe (if isWin+              then+                GameFinished (b' `FinishedBoard` win w)+              else+                if isDraw+                then+                  GameFinished (b' `FinishedBoard` draw)+                else+                  KeepPlaying b') (const PositionAlreadyOccupied) j++(-?->) ::+  Position+  -> MoveResult+  -> MoveResult+p -?-> r =+  keepPlayingOr r (\b -> p --> b) r++infixr 5 -?->++-- | The result of making a move on a tic-tac-toe board.+data MoveResult =+  PositionAlreadyOccupied -- ^ The move was to a position that is already occupied by a player.+  | KeepPlaying Board -- ^ The move was valid and the board is in a new state.+  | GameFinished FinishedBoard -- ^ The move was valid and the game is complete.+  deriving Eq++-- | Deconstruct a move result.+foldMoveResult ::+  a -- ^ The move was to a position that is already occupied by a player.+  -> (Board -> a) -- ^ The move was valid and the board is in a new state.+  -> (FinishedBoard -> a) -- ^ The move was valid and the game is complete.+  -> MoveResult+  -> a+foldMoveResult occ _ _ PositionAlreadyOccupied =+  occ+foldMoveResult _ kp _ (KeepPlaying b) =+  kp b+foldMoveResult _ _ gf (GameFinished b) =+  gf b++-- | Return the value after function application to the board to keep playing.+keepPlayingOr ::+  a -- ^ The value to return if there is no board to keep playing with.+  -> (Board -> a) -- ^ A function to apply to the board to keep playing with.+  -> MoveResult+  -> a+keepPlayingOr def kp =+  foldMoveResult def kp (const def)++-- | Return the possible board from a move result. A board is returned if the result is to continue play.+keepPlaying ::+  MoveResult+  -> Maybe Board+keepPlaying (KeepPlaying b) =+  Just b+keepPlaying _               =+  Nothing++instance Show MoveResult where+  show PositionAlreadyOccupied = "*Position already occupied*"+  show (KeepPlaying b)         = concat ["{", show b, "}"]+  show (GameFinished b)        = concat ["{{", show b, "}}"]++class TakeBack to from | to -> from where+  takeBack ::+    to+    -> from++instance TakeBack FinishedBoard Board where+  takeBack (FinishedBoard (Board ((p, _):t) m) _) =+    Board t (p `M.delete` m)+  takeBack (FinishedBoard (Board [] _) _) =+    error "Broken invariant: board-in-play with empty move list. This is a program bug."++data TakenBack =+  TakeBackIsEmpty+  | TakeBackIsBoard Board+  deriving Eq++foldTakenBack ::+  a+  -> (Board -> a)+  -> TakenBack+  -> a++foldTakenBack e _ TakeBackIsEmpty =+  e+foldTakenBack _ k (TakeBackIsBoard b) =+  k b++takenBackBoard ::+  TakenBack+  -> Maybe Board+takenBackBoard =+  foldTakenBack Nothing Just++instance TakeBack Board TakenBack where+  takeBack (Board (_:[]) _) =+    TakeBackIsEmpty+  takeBack (Board ((p, _):t) m) =+    TakeBackIsBoard (Board t (p `M.delete` m))+  takeBack (Board [] _) =+    error "Broken invariant: board-in-play with empty move list. This is a program bug."++-- | A tic-tac-toe board.+data Board =+  Board [(Position, Player)] !(M.Map Position Player)+  deriving Eq++instance Show Board where+  show b@(Board _ m) =+    intercalate " " [showPositionMap m, "[", show (whoseTurn b), "to move ]"]++-- | A finished board is a completed tic-tac-toe game and does not accept any more moves.+data FinishedBoard =+  FinishedBoard Board GameResult+  deriving Eq++-- | Return the result of a completed tic-tac-toe game.+getResult ::+  FinishedBoard+  -> GameResult+getResult (FinishedBoard _ r) =+  r++instance Show FinishedBoard where+  show (FinishedBoard (Board _ m) r) =+    let summary = gameResult (\p -> show p ++ " wins") "draw" r+    in intercalate " " [showPositionMap m, "[[", summary, "]]"]++-- | Start an empty tic-tac-toe board.+empty ::+  EmptyBoard+empty =+  EmptyBoard++-- | Prints out a board using ASCII notation and substituting the returned string for each position.+printEachPosition ::+  (Position -> String) -- ^ The function returning the string to substitute each position.+  -> IO ()+printEachPosition k =+  let z = ".===.===.===."+      lines = [+                z+              , concat ["| ", k NW, " | ", k N , " | ", k NE, " |"]+              , z+              , concat ["| ", k W , " | ", k C , " | ", k E , " |"]+              , z+              , concat ["| ", k SW, " | ", k S , " | ", k SE, " |"]+              , z+              ]+  in forM_ lines putStrLn++-- | Functions that work on boards that are in play or have completed.+--+-- This class specifically does not specify moving on a board, since this is illegal on a completed board.+class BoardLike b where+  -- | Returns whose turn it is on a tic-tac-toe board.+  whoseTurn ::+    b+    -> Player+  whoseTurn =+    alternate . whoseNotTurn++  -- | Returns whose turn it is not on a tic-tac-toe board.+  whoseNotTurn ::+    b+    -> Player+  whoseNotTurn =+    alternate . whoseTurn++  -- | Returns whether or not the board is empty.+  isEmpty ::+    b+    -> Bool++  -- | Returns positions that are occupied.+  occupiedPositions ::+    b+    -> S.Set Position++  -- | Returns the number of moves that have been played.+  moves ::+    b+    -> Int++  -- | Returns whether or not the first given board can transition to the second given board.+  isSubboardOf ::+    b+    -> b+    -> Bool++  -- | Returns whether or not the first given board can transition to the second given board and they are inequal.+  isProperSubboardOf ::+    b+    -> b+    -> Bool++  -- | Returns the player at the given position.+  playerAt ::+    b+    -> Position+    -> Maybe Player++  -- | Returns the player at the given position or the given default.+  playerAtOr ::+    b+    -> Position+    -> Player+    -> Player+  playerAtOr b p q =+    q `fromMaybe` playerAt b p++  -- | Returns whether or not the given position is occupied on the board. @true@ if occupied.+  isOccupied ::+    b+    -> Position+    -> Bool+  isOccupied b p =+    isJust $ playerAt b p++  -- | Returns whether or not the given position is occupied on the board. @false@ if occupied.+  isNotOccupied ::+    b+    -> Position+    -> Bool+  isNotOccupied b p =+    not (isOccupied b p)++  -- | Prints the board to standard output using an ASCII grid representation.+  printBoard ::+    b+    -> IO ()++instance BoardLike EmptyBoard where+  whoseTurn _ =+    player1++  isEmpty _ =+    True++  occupiedPositions _ =+    S.empty++  moves _ =+    0++  isSubboardOf _ _ =+    True++  isProperSubboardOf _ _ =+    False++  playerAt _ _ =+    Nothing++  printBoard _ =+    printEachPosition (pos M.empty " ")++instance BoardLike Board where+  whoseTurn (Board [] _) =+    player1++  whoseTurn (Board ((_, q):_) _) =+    alternate q++  isEmpty _ =+    False++  occupiedPositions (Board _ m) =+    M.keysSet m++  moves (Board _ m) =+    M.size m++  isSubboardOf (Board _ m) (Board _ m') =+    m `M.isSubmapOf` m'++  isProperSubboardOf (Board _ m) (Board _ m') =+    m `M.isProperSubmapOf` m'++  playerAt (Board _ m) p =+    p `M.lookup` m++  printBoard (Board _ m) =+    printEachPosition (pos m " ")++instance BoardLike FinishedBoard where+  isEmpty (FinishedBoard b _) =+    isEmpty b++  occupiedPositions (FinishedBoard b _) =+    occupiedPositions b++  moves (FinishedBoard b _) =+    moves b++  isSubboardOf (FinishedBoard b _) (FinishedBoard b' _) =+    b `isSubboardOf` b'++  isProperSubboardOf (FinishedBoard b _) (FinishedBoard b' _) =+    b `isProperSubboardOf` b'++  playerAt (FinishedBoard b _) p =+    b `playerAt` p++  printBoard (FinishedBoard b _) =+    printBoard b++-- not exported++pos ::+  Ord k =>+  M.Map k Player+  -> String+  -> k+  -> String+pos m empty p =+  maybe empty (return . toSymbol) (p `M.lookup` m)++showPositionMap ::+  M.Map Position Player+  -> String+showPositionMap m =+  let pos' = pos m "?"+  in concat [ ".=",  pos' NW, "=.=", pos' N , "=.=", pos' NE+            , "=.=", pos' W , "=.=", pos' C , "=.=", pos' E+            , "=.=", pos' SW, "=.=", pos' S , "=.=", pos' SE, "=."+            ]
+ Data/TicTacToe/GameResult.hs view
@@ -0,0 +1,98 @@+-- | A game result is one of+--+-- * Player 1 wins+--+-- * Player 2 wins+--+-- * Neither player wins (draw)+module Data.TicTacToe.GameResult+(+  GameResult+-- * Reduction (fold)+, gameResult+, playerGameResult+-- * Construction+, win+, player1Wins+, player2Wins+, draw+-- * Decisions+, isPlayer1Wins+, isPlayer2Wins+, isDraw+) where++import Data.TicTacToe.Player++-- | A game result.+data GameResult =+  Win Player+  | Draw+  deriving (Eq, Show)++-- | Fold a game result.+gameResult ::+  (Player -> x) -- ^ If either of the players won.+  -> x -- ^ If the game was a draw.+  -> GameResult -- ^ The game result to fold.+  -> x+gameResult win _    (Win p) =+  win p+gameResult _   draw Draw    =+  draw++-- | Fold a game result.+playerGameResult ::+  x -- ^ If player 1 won.+  -> x -- ^ If player 2 won.+  -> x -- ^ If the game was a draw.+  -> GameResult -- ^ The game result to fold.+  -> x+playerGameResult p1 p2 =+  gameResult (player p1 p2)++-- | Construct a game result with a win for the given player.+win ::+  Player -- ^ The player to win.+  -> GameResult+win =+  Win++-- | Construct a game result with a win for player 1.+player1Wins ::+  GameResult+player1Wins =+  Win player1++-- | Construct a game result with a win for player 2.+player2Wins ::+  GameResult+player2Wins =+  Win player2++-- | Construct a game result that is a draw.+draw ::+  GameResult+draw =+  Draw++-- | Returns whether or not player 1 won for the game result.+isPlayer1Wins ::+  GameResult+  -> Bool+isPlayer1Wins =+  playerGameResult True False False++-- | Returns whether or not player 2 won for the game result.+isPlayer2Wins ::+  GameResult+  -> Bool+isPlayer2Wins =+  playerGameResult False True False++-- | Returns whether the game result is a draw.+isDraw ::+  GameResult+  -> Bool+isDraw =+  playerGameResult False False True
+ Data/TicTacToe/Interact.hs view
@@ -0,0 +1,127 @@+-- | Play tic-tac-toe interactively.+module Data.TicTacToe.Interact+(+  tictactoe+) where++import Data.TicTacToe.Board+import Data.TicTacToe.Position+import Data.TicTacToe.Player+import Data.TicTacToe.GameResult+import Data.Char+import Control.Monad++-- | Play tic-tac-toe interactively.+tictactoe ::+  IO ()+tictactoe =+  gameLoop (\b' -> do surround $ printWithoutPositions b'+                      tictactoe' b') empty++gameLoop ::+  (BoardLike b, Move b to) =>+  (to -> IO ())+  -> b+  -> IO ()+gameLoop k b =+  let p = whoseTurn b+  in do putStrLns+          [+            show p ++ " to move [" ++ [toSymbol p] ++ "]"+          , "  [1-9] to Move"+          , "  q to Quit"+          , "  v to view board positions"+          ]+        putStr "  > "+        c <- getChar+        if c `elem` "vV"+          then+            do surround $ printWithPositions b+               gameLoop k b+          else+            if c `elem` ['1'..'9']+              then+                k (toPosition (digitToInt c) --> b)+              else+                if c `elem` "qQ"+                  then+                    do line+                       putStrLn "Bye!"+                  else+                    do surround $ putStrLn "Invalid selection. Please try again."+                       gameLoop k b++tictactoe' ::+  Board+  -> IO ()+tictactoe' b =+  gameLoop (foldMoveResult+              (do surround $ putStrLn "That position is already taken. Try again."+                  printWithoutPositions b+                  line+                  tictactoe' b)+              (\b' -> do surround $ printWithoutPositions b'+                         tictactoe' b')+              (\b' -> do surround $ printWithoutPositions b'+                         putStrLn (playerGameResult "Player 1 Wins!" "Player 2 Wins!" "Draw" (getResult b'))))+            b++surround ::+  IO ()+  -> IO ()+surround a =+  do nlines 2+     a+     line++putStrLns ::+  [String]+  -> IO ()+putStrLns =+  mapM_ putStrLn++line ::+  IO ()+line =+  nlines 1++nlines ::+  Int+  -> IO ()+nlines n =+  replicateM_ n (putStrLn [])++printWithPositions ::+  BoardLike b =>+  b+  -> IO ()+printWithPositions =+  printPositions (show . fromPosition)++printWithoutPositions ::+  BoardLike b =>+  b+  -> IO ()+printWithoutPositions =+  printPositions (const " ")++printPositions ::+  BoardLike b =>+  (Position -> String)+  -> b+  -> IO ()+printPositions k b =+  printEachPosition (\p -> maybe (k p) (return . toSymbol) (b `playerAt` p))++fromPosition ::+  Position+  -> Int+fromPosition =+  succ . fromEnum++toPosition ::+  Int+  -> Position+toPosition n =+  toEnum (n - 1)+
+ Data/TicTacToe/Player.hs view
@@ -0,0 +1,81 @@+-- | A player is either player 1 or player 2 /(isomorphic to Bool)/.+module Data.TicTacToe.Player+(+Player+-- * Reduction+, player+-- * Construction+, player1+, player2+-- * Decisions+, isPlayer1+, isPlayer2+-- * Combinator+, alternate+, toSymbol+) where++-- | A player.+data Player =+  Player1+  | Player2+  deriving (Eq, Ord, Enum)++instance Show Player where+  show Player1 = "Player 1"+  show Player2 = "Player 2"++-- | Returns whether or not the player is player 1.+isPlayer1 ::+  Player ->+  Bool+isPlayer1 Player1 =+  True+isPlayer1 Player2 =+  False++-- | Returns whether or not the player is player 2.+isPlayer2 ::+  Player+  -> Bool+isPlayer2 =+  not . isPlayer1++-- | Player 1.+player1 ::+  Player+player1 =+  Player1++-- | Player 2.+player2 ::+  Player+player2 =+  Player2++-- | Folds a player.+player ::+  x -- ^ If player 1.+  -> x -- ^ If player 2.+  -> Player -- ^ The player to fold.+  -> x+player x _ Player1 =+  x+player _ x Player2 =+  x++-- | Switches a player from player 1 to player 2 or vice versa.+alternate ::+  Player -- ^ The player to alternate.+  -> Player+alternate Player1 =+  Player2+alternate Player2 =+  Player1++-- | Returns a character symbol denoting each player.+toSymbol ::+  Player+  -> Char+toSymbol =+  player 'X' 'O'
+ Data/TicTacToe/Position.hs view
@@ -0,0 +1,29 @@+-- | A position is one of the nine places on a tic-tac-toe grid.+module Data.TicTacToe.Position+(+  Position(..)+) where++-- A tic-tac-toe position.+data Position =+  NW -- ^ North-west (top left).+  | N -- ^ North (top centre).+  | NE -- ^ North-east (top right).+  | W -- ^ West (middle left).+  | C -- ^ Centre.+  | E -- ^ East (middle right)+  | SW -- ^ South-west (bottom left).+  | S -- ^ South (bottom centre).+  | SE -- ^ South-east (bottom right).+  deriving (Eq, Ord, Enum, Bounded)++instance Show Position where+  show NW = "NW"+  show N  = "N "+  show NE = "NE"+  show E  = "E "+  show SE = "SE"+  show S  = "S "+  show SW = "SW"+  show W  = "W "+  show C  = "C "
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2009 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ Test/Data/TicTacToe.hs view
@@ -0,0 +1,30 @@+module Test.Data.TicTacToe+(+  main+, tictactoeTests+) where++import Test.Data.TicTacToe.Board hiding (main)+import Test.Data.TicTacToe.Position hiding (main)+import Test.Data.TicTacToe.Player hiding (main)+import Test.Data.TicTacToe.GameResult hiding (main)+import Test.Framework++main ::+  IO ()+main =+  defaultMain tictactoeTests++tictactoeTests ::+  [Test]+tictactoeTests =+  [+    testGroup "TicTacToe" $+      concat+      [ boardTests+      , positionTests+      , playerTests+      , gameResultTests+      ]+  ]+
+ Test/Data/TicTacToe/Board.hs view
@@ -0,0 +1,59 @@+module Test.Data.TicTacToe.Board+(+  main+, boardTests+) where+++import Prelude hiding (all, any)+import Data.TicTacToe.Board+import Data.TicTacToe.Position+import Data.Foldable+import Test.Data.TicTacToe.Position()+import Test.QuickCheck+import Test.Framework+import Test.Framework.Providers.QuickCheck2 (testProperty)++instance Arbitrary Board where+  arbitrary =+    do p <- arbitrary+       q <- resize 12 arbitrary+       return $ Prelude.foldr (\p b -> keepPlayingOr b id (p --> b)) (p --> empty) q+++main ::+  IO ()+main =+  defaultMain boardTests++boardTests ::+  [Test]+boardTests =+  [+    testGroup "Board"+      [+        testProperty "whoseTurn"       prop_whoseTurn+      , testProperty "move_whoseTurn"  prop_move_whoseTurn+      , testProperty "move_moveBack"   prop_move_takeBack+      ]+  ]++prop_whoseTurn ::+  Board+  -> Bool+prop_whoseTurn b =+  whoseTurn b /= whoseNotTurn b++prop_move_whoseTurn ::+  Board+  -> Position+  -> Bool+prop_move_whoseTurn b p =+  (\b' -> whoseTurn b /= whoseTurn b') `all` keepPlaying (p --> b)++prop_move_takeBack ::+  Board+  -> Position+  -> Bool+prop_move_takeBack b p =+  foldMoveResult True (foldTakenBack False (==b) . takeBack) (\fb -> takeBack fb == b) (p --> b)
+ Test/Data/TicTacToe/GameResult.hs view
@@ -0,0 +1,50 @@+module Test.Data.TicTacToe.GameResult+(+  main+, gameResultTests+) where++import Data.TicTacToe.GameResult+import Test.QuickCheck+import Test.Framework+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Data.TicTacToe.Player()++instance Arbitrary GameResult where+  arbitrary = fmap (maybe draw win) arbitrary++main ::+  IO ()+main =+  defaultMain gameResultTests++gameResultTests ::+  [Test]+gameResultTests =+  [+    testGroup "GameResult"+      [+        testProperty "cata_ctor"  prop_cata_ctor+      , testProperty "cata_ctor2" prop_cata_ctor2+      , testProperty "is"         prop_is+      ]+  ]++prop_cata_ctor ::+  GameResult+  -> Bool+prop_cata_ctor r =+  gameResult win draw r == r++prop_cata_ctor2 ::+  GameResult+  -> Bool+prop_cata_ctor2 r =+  playerGameResult player1Wins player2Wins draw r == r++prop_is ::+  GameResult+  -> Bool+prop_is p =+  playerGameResult isPlayer1Wins isPlayer2Wins isDraw p p+
+ Test/Data/TicTacToe/Player.hs view
@@ -0,0 +1,50 @@+module Test.Data.TicTacToe.Player+(+  main+, playerTests+) where++import Data.TicTacToe.Player+import Test.QuickCheck+import Test.Framework+import Test.Framework.Providers.QuickCheck2 (testProperty)++instance Arbitrary Player where+  arbitrary = elements [player1, player2]+++main ::+  IO ()+main =+  defaultMain playerTests++playerTests ::+  [Test]+playerTests =+  [+    testGroup "Player"+      [+        testProperty "is_exclusive" prop_is_exclusive+      , testProperty "cata_ctor"    prop_cata_ctor+      , testProperty "alternate"    prop_alternate+      ]+  ]++prop_is_exclusive ::+  Player+  -> Bool+prop_is_exclusive p =+  isPlayer1 p /= isPlayer2 p++prop_cata_ctor ::+  Player+  -> Bool+prop_cata_ctor p =+  player player1 player2 p == p++prop_alternate ::+  Player+  -> Bool+prop_alternate p =+  (alternate p /= p) && (alternate (alternate p) == p)+
+ Test/Data/TicTacToe/Position.hs view
@@ -0,0 +1,35 @@+module Test.Data.TicTacToe.Position+(+  main+, positionTests+) where++import Data.TicTacToe.Position+import Test.QuickCheck+import Test.Framework+import Test.Framework.Providers.QuickCheck2 (testProperty)++instance Arbitrary Position where+  arbitrary = elements [minBound ..]++main ::+  IO ()+main =+  defaultMain positionTests++positionTests ::+  [Test]+positionTests =+  [+    testGroup "Position"+      [+        testProperty "show is length 2" prop_show_is_two+      ]+  ]++prop_show_is_two ::+  Position+  -> Bool+prop_show_is_two p =+  length (show p) == 2+
+ TicTacToe view
@@ -0,0 +1,45 @@+TicTacToe+=========++Write an API for the tic-tac-toe game. Do not use variables -- they are not permitted. This includes libraries that expose in-line updates. No exceptions (or non-termination) in exposed functions -- all functions return a consistent value for every element of their domain. The follow API methods should exist:++* move: takes a tic-tac-toe board and position and moves to that position (if not occupied) returning a new board. This function can only be called on a board that is in-play. Calling move on a game board that is finished is a *compile-time type error*.++* whoWon: takes a tic-tac-toe board and returns the player that won the game (or a draw if neither). This function can only be called on a board that is finished. Calling move on a game board that is in-play is a *compile-time type error*.++* takeBack: takes either a finished board or a board in-play that has had at least one move and returns a board in-play. It is a compile-time type error to call this function on an empty board.++* playerAt: takes a tic-tac-toe board and position and returns the (possible) player at a given position. This function works on any type of board.++* Other API functions that you may see fit. These can be determined by also writing an interactive console application that uses the API -- other useful functions are likely to arise.++You should write automated tests for your API. For example, the following universally quantified property holds true:++forall Board b. forall Position p. such that (not (positionIsOccupied+p b)). takeBack(move(p, b)) == b++You should encode this property in an automated specification test. For Scala, use ScalaCheck. For Haskell, QuickCheck. For Java, consider Functional Java. For other languages such as C# or F#, you may need to search around.++Haskell-specific+----------------++If you choose to use Haskell, also take advantage of its superior tooling:++* Build with CABAL+* Include a .ghci for convenience when developing+  * http://haskell.org/ghc/docs/6.12.2/html/users_guide/ghci-dot-files.html+* API documented using Haddock+  * http://www.haskell.org/haddock/doc/html/index.html+* Code style examined using hlint+  * cabal install hlint+  * Produce a report (--report)+  * http://community.haskell.org/~ndm/darcs/hlint/hlint.htm+* Use hoogle and hayoo to find library functions+  * http://haskell.org/hoogle/+  * http://holumbus.fh-wedel.de/hayoo/hayoo.html+++Extra-curricular+----------------+* Write an opponent that never loses+* Write an opponent with easy, medium, hard difficulty levels
+ TicTacToe.cabal view
@@ -0,0 +1,44 @@+Name:               TicTacToe+Version:            0.0.1+Author:             Tony Morris <tmorris@tmorris.net>+Maintainer:         Tony Morris+License:            BSD3+License-File:       LICENSE+Extra-Source-Files: TicTacToe+Synopsis:           A sub-project (exercise) for a functional programming course+Category:           Education+Description:        A sub-project (exercise) for a functional programming course+Cabal-version:      >= 1.2+Build-Type:         Simple++Flag small_base+  Description:      Choose the new, split-up base package.++Library+  Build-Depends:+                    base < 5 && >= 4+                    , containers+                    , HUnit+                    , QuickCheck+                    , test-framework+                    , test-framework-hunit+                    , test-framework-quickcheck2++  GHC-Options:+                    -Wall+                    -fno-warn-orphans+                    -fno-warn-type-defaults+                    -fno-warn-name-shadowing++  Exposed-Modules:+                    Data.TicTacToe+                    , Data.TicTacToe.Board+                    , Data.TicTacToe.Position+                    , Data.TicTacToe.Player+                    , Data.TicTacToe.GameResult+                    , Data.TicTacToe.Interact+                    , Test.Data.TicTacToe+                    , Test.Data.TicTacToe.Board+                    , Test.Data.TicTacToe.Position+                    , Test.Data.TicTacToe.Player+                    , Test.Data.TicTacToe.GameResult