tak (empty) → 0.1.0.0
raw patch · 18 files changed
+1466/−0 lines, 18 filesdep +HUnitdep +basedep +bytestringsetup-changed
Dependencies added: HUnit, base, bytestring, hashable, hslogger, matrix, network, parsec, random-shuffle, safe
Files
- LICENSE +17/−0
- Setup.hs +2/−0
- src/PlayTak.hs +71/−0
- src/PlayTak/Commands.hs +61/−0
- src/PlayTak/Parser.hs +282/−0
- src/PlayTak/Types.hs +44/−0
- src/PlayTakBot.hs +158/−0
- src/Tak.hs +16/−0
- src/Tak/ApplyPlay.hs +113/−0
- src/Tak/Init.hs +31/−0
- src/Tak/ParsePTN.hs +69/−0
- src/Tak/PossiblePlays.hs +66/−0
- src/Tak/ShowPTN.hs +34/−0
- src/Tak/Tree.hs +63/−0
- src/Tak/Types.hs +177/−0
- src/Tak/Win.hs +71/−0
- src/tests.hs +141/−0
- tak.cabal +50/−0
+ LICENSE view
@@ -0,0 +1,17 @@+Copyright (c) 2016, Henry Bucklow+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.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT OWNER 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,2 @@+import Distribution.Simple+main = defaultMain
+ src/PlayTak.hs view
@@ -0,0 +1,71 @@+module PlayTak (+ module PlayTak.Commands,+ module PlayTak.Parser,+ module PlayTak.Types,+ playTakClient+) where++import Control.Concurrent+import Control.Monad+import qualified Data.ByteString.Char8 as BS+import Network.Socket hiding (recv, send)+import Network.Socket.ByteString++import PlayTak.Commands+import PlayTak.Parser+import PlayTak.Types++type PlayTakHandler a = PlayTakClient -> PlayTakMsg -> a -> IO a++playTakClient :: PlayTakHandler a -> a -> IO ()+playTakClient handler state = do+ sock <- socket AF_INET Stream defaultProtocol+ addrs <- getAddrInfo Nothing (Just "playtak.com") (Just "10000")+ connect sock $ addrAddress $ head addrs+ + chanMsg <- newChan+ chanCmd <- newChan+ + _ <- forkOS $ handleMessages chanMsg chanCmd handler state+ _ <- forkOS $ pinger chanCmd+ _ <- forkOS $ writer sock chanCmd+ + reader sock chanMsg++handleMessages :: Chan PlayTakMsg -> Chan String -> PlayTakHandler a -> a -> IO ()+handleMessages chanMsg chanCmd handler state = loop state where+ loop currState = do+ msg <- readChan chanMsg+ currState' <- handler ptc msg currState+ loop currState'+ ptc = PlayTakClient chanCmd++pinger :: Chan String -> IO ()+pinger chanCmd = forever $ do+ writeChan chanCmd "PING"+ threadDelay $ 15 * 1000000++writer :: Socket -> Chan String -> IO ()+writer sock chanCmd = forever $ do+ cmd <- readChan chanCmd+ send' $ cmd ++ "\n"+ where+ send' str = do+ sent <- send sock $ BS.pack str+ if sent < length str then error "Not all data sent" else return ()++reader :: Socket -> Chan PlayTakMsg -> IO ()+reader sock chanMsg = loop BS.empty where+ loop leftover = do+ str <- if BS.elem '\n' leftover+ then return leftover+ else do+ received <- recv sock 4096+ return $ BS.append leftover received+ let (line, rest) = BS.breakSubstring (BS.pack "\n") str+ rest' = if BS.length rest == 0 then rest else BS.tail rest+ -- print line+ case parsePlayTak line of+ Left err -> writeChan chanMsg $ ParseFailed (BS.unpack line) err+ Right msg -> writeChan chanMsg msg+ loop rest'
+ src/PlayTak/Commands.hs view
@@ -0,0 +1,61 @@+module PlayTak.Commands (+ client,+ login,+ seek,+ acceptGame,+ sendPlay+) where++import Control.Concurrent+import Data.List++import Tak++import PlayTak.Types++client :: PlayTakClient -> String -> IO ()+client ptc name = do+ sendCmd ptc $ "Client " ++ name++login :: PlayTakClient -> Username -> Password -> IO ()+login ptc username password = do+ sendCmd ptc $ "Login " ++ username ++ " " ++ password++seek :: PlayTakClient -> Size -> Time -> Time -> Maybe Colour -> IO ()+seek ptc size time incr mColour =+ sendCmd ptc $ "Seek " ++ show size ++ " " ++ show time ++ " " ++ show incr +++ case mColour of+ Nothing -> ""+ Just White -> " W"+ Just Black -> " B"++acceptGame :: PlayTakClient -> GameNumber -> IO ()+acceptGame ptc gameno = do+ sendCmd ptc $ "Accept " ++ show gameno++sendPlay :: PlayTakClient -> GameNumber -> Play -> IO ()+sendPlay ptc gameno play = do+ let cmd = "Game#" ++ show gameno ++ " " ++ case play of+ Place stone loc -> "P " ++ square loc ++ case stone of+ Flat -> ""+ Cap -> " C"+ Standing -> " W"+ Move loc dir drops -> "M " ++ square loc+ ++ " " ++ square (endSquare loc dir $ length drops)+ ++ " " ++ (concat $ intersperse " " $ map show drops)+ sendCmd ptc cmd++sendCmd :: PlayTakClient -> String -> IO ()+sendCmd ptc cmd = writeChan (clientChanCmd ptc) cmd++endSquare :: Loc -> Dir -> Int -> Loc+endSquare (i, j) PosX steps = (i + steps, j)+endSquare (i, j) NegX steps = (i - steps, j)+endSquare (i, j) PosY steps = (i, j + steps)+endSquare (i, j) NegY steps = (i, j - steps)++square :: Loc -> String+square (i, j) = (ranks !! (i - 1)) : show j++ranks :: String+ranks = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ src/PlayTak/Parser.hs view
@@ -0,0 +1,282 @@+module PlayTak.Parser (parsePlayTak, PlayTakMsg(..)) where++import qualified Data.ByteString as BS+import Data.List+import Data.Maybe+import Text.Parsec hiding (char, string, space)+import qualified Text.Parsec as Parsec++import Tak++import PlayTak.Types++type Parser a = Parsec BS.ByteString () a++parsePlayTak :: BS.ByteString -> Either ParseError PlayTakMsg+parsePlayTak str = parse playtak "" str++playtak :: Parser PlayTakMsg+playtak = welcome+ <|> loginOrRegister+ <|> loggedIn+ <|> seek+ <|> online+ <|> shout+ <|> gameStart+ <|> game+ <|> gamelist+ <|> message+ <|> errorMsg+ <|> nok+ <|> ok++welcome :: Parser PlayTakMsg+welcome = try (string "Welcome!") >> return Welcome++loginOrRegister :: Parser PlayTakMsg+loginOrRegister = string "Login or Register" >> return PleaseLogin++loggedIn :: Parser PlayTakMsg+loggedIn = do+ try $ string "Welcome"+ space+ name <- username+ char '!'+ return $ LoggedIn name++seek :: Parser PlayTakMsg+seek = do+ try $ string "Seek"+ space+ s <- (string "new" >> return SeekNew)+ <|> (string "remove" >> return SeekRemove)+ space+ no <- int+ space+ name <- username+ space+ boardsize <- int+ space+ gameTime <- int+ return $ s no name boardsize gameTime++online :: Parser PlayTakMsg+online = do+ try $ string "Online"+ space+ name <- username+ return $ Online name++shout :: Parser PlayTakMsg+shout = do+ try $ string "Shout"+ space+ char '<'+ name <- username+ char '>'+ space+ msg <- many1 anyChar+ return $ Shout name msg+ +--Game Start no size player_white vs player_black your color+gameStart :: Parser PlayTakMsg+gameStart = do+ try $ string "Game Start"+ space+ gameno <- int+ space+ size <- int+ space+ p1 <- username+ space+ string "vs"+ space+ p2 <- username+ space+ c <- colour+ return $ GameStart gameno size p1 p2 c++game :: Parser PlayTakMsg+game = do+ try $ string "Game#"+ n <- int+ space+ place n <|> move n <|> time n <|> over n <|> offerDraw n <|> removeDraw n+ <|> resign n <|> requestUndo n <|> removeUndo n <|> undo n <|> abandon n++--Game#no P Sq C|W+place :: Int -> Parser PlayTakMsg+place gameno = do+ char 'P'+ space+ sq <- square+ stone <- option Flat $ space >> (cap <|> wall)+ return $ PlayMsg gameno $ Place stone sq+ where+ cap = char 'C' >> return Cap+ wall = char 'W' >> return Standing+ +--Game#no M Sq1 Sq2 no1 no2...+move :: Int -> Parser PlayTakMsg+move gameno = do+ char 'M'+ space+ sq1 <- square+ space+ sq2 <- square+ space+ drops <- int `sepBy1` space+ return $ PlayMsg gameno $ Move sq1 (dir sq2 sq1) drops+ where+ dir (i1, j1) (i2, j2) = dir' (signum $ i1 - i2) (signum $ j1 - j2)+ dir' 1 0 = PosX+ dir' (-1) 0 = NegX+ dir' 0 1 = PosY+ dir' 0 (-1) = NegY+ dir' _ _ = error "Not a legal direction"++--Game#no Time whitetime blacktime+time :: Int -> Parser PlayTakMsg+time gameno = do+ try $ string "Time"+ space+ whitetime <- int+ space+ blacktime <- int+ return $ Time gameno whitetime blacktime++--Game#no Over result+over :: Int -> Parser PlayTakMsg+over gameno = do+ try $ string "Over"+ space+ p1 <- score+ char '-'+ p2 <- score+ return $ Over gameno p1 p2+ where+ score = roadScore <|> flatScore <|> drawScore <|> zeroScore <|> abandonScore+ zeroScore = char '0' >> return ZeroScore+ roadScore = char 'R' >> return RoadScore+ flatScore = char 'F' >> return FlatScore+ drawScore = try (string "1/2") >> return DrawScore+ abandonScore = char '1' >> return AbandonScore++--Game#no OfferDraw+offerDraw :: Int -> Parser PlayTakMsg+offerDraw gameno = string "OfferDraw" >> return (OfferDraw gameno)++removeDraw :: Int -> Parser PlayTakMsg+removeDraw gameno = try (string "RemoveDraw") >> return (RemoveDraw gameno)++resign :: Int -> Parser PlayTakMsg+resign gameno = try (string "Resign") >> return (Resign gameno)++requestUndo :: Int -> Parser PlayTakMsg+requestUndo gameno = try (string "RequestUndo") >> return (RequestUndo gameno)++removeUndo :: Int -> Parser PlayTakMsg+removeUndo gameno = try (string "RemoveUndo") >> return (RemoveUndo gameno)++undo :: Int -> Parser PlayTakMsg+undo gameno = string "Undo" >> return (Undo gameno)++abandon :: Int -> Parser PlayTakMsg+abandon gameno = string "Abandoned" >> return (Abandon gameno)++message :: Parser PlayTakMsg+message = do+ string "Message"+ space+ text <- many anyChar+ return $ Message text++errorMsg :: Parser PlayTakMsg+errorMsg = do+ string "Error"+ space+ text <- many anyChar+ return $ ErrorMsg text++nok :: Parser PlayTakMsg+nok = string "NOK" >> return NOK++ok :: Parser PlayTakMsg+ok = try (string "OK") >> return OK++--GameList Add Game#no player_white vs player_black, sizexsize, original_time, moves half-moves played, player_name to move+gamelist :: Parser PlayTakMsg+gamelist = do+ try $ string "GameList"+ space+ proc <- (string "Add" >> return GameListAdd) <|>+ (string "Remove" >> return GameListRemove)+ space+ string "Game#"+ gameno <- int+ space+ p1 <- username+ space+ string "vs"+ space+ p2 <- username+ comma+ space+ size1 <- int+ char 'x'+ size2 <- int+ if size1 /= size2+ then error "Board is not square!"+ else return ()+ comma+ space+ gameTime <- int+ comma+ space+ seconds <- int+ comma+ space+ moves <- int+ space+ string "half-moves played"+ comma+ space+ nextPlayer <- username+ space+ string "to move"+ return $ proc gameno p1 p2 size1 gameTime seconds moves nextPlayer++username :: Parser String+username = many1 $ noneOf " <>!,"++comma :: Parser ()+comma = char ','++int :: Parser Int+int = do+ n <- many1 digit+ return $ read n++colour :: Parser Colour+colour = white <|> black where+ white = string "white" >> return White+ black = string "black" >> return Black++square :: Parser (Int, Int)+square = do+ rank <- oneOf letters+ file <- int+ return ((fromJust $ elemIndex rank letters) + 1, file)++letters :: String+letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"++-- Versions of Parsec parsers that don't return a value.+char :: Char -> Parser ()+char c = Parsec.char c >> return ()++space :: Parser ()+space = Parsec.space >> return ()++string :: String -> Parser ()+string str = Parsec.string str >> return ()
+ src/PlayTak/Types.hs view
@@ -0,0 +1,44 @@+module PlayTak.Types where++import Control.Concurrent++import Text.Parsec++import Tak++data PlayTakClient = PlayTakClient {+ clientChanCmd :: Chan String+}++type Username = String+type Password = String++type Size = Int+type GameNumber = Int+type Time = Int++data PlayTakMsg = Welcome | PleaseLogin | LoggedIn Username+ | SeekNew GameNumber Username Size Time+ | SeekRemove GameNumber Username Size Time+ | Online Username+ | Shout Username String+ | GameStart GameNumber Size Username Username Colour+ | PlayMsg GameNumber Play+ | Time GameNumber Time Time+ | Over GameNumber Score Score+ | OfferDraw GameNumber+ | RemoveDraw GameNumber+ | Resign GameNumber+ | RequestUndo GameNumber+ | RemoveUndo GameNumber+ | Undo GameNumber+ | Abandon GameNumber+ | Message String+ | ErrorMsg String+ | NOK+ | OK+ | GameListAdd GameNumber Username Username Size Time Int Int Username+ | GameListRemove GameNumber Username Username Size Time Int Int Username+ | ParseFailed String ParseError deriving Show++data Score = RoadScore | FlatScore | DrawScore | ZeroScore | AbandonScore deriving Show
+ src/PlayTakBot.hs view
@@ -0,0 +1,158 @@+module PlayTakBot where++import Data.Maybe+import Safe+import System.Log.Logger++import Tak+import PlayTak++class Bot b where+ botName :: b -> String+ botPassword :: b -> String+ botEvaluate :: b -> Colour -> GameState -> Double+ botChoosePlay :: b -> BotGameState -> (Play, BotGameState, Double)+ botHandle :: b -> PlayTakClient -> PlayTakMsg -> BotState -> IO BotState+ botHandle = botHandleDefault+ botHandleDefault :: b -> PlayTakClient -> PlayTakMsg -> BotState -> IO BotState+ botHandleDefault = handle++data BotState = BotState {+ bstGame :: Maybe (Int, BotGameState)+}++data BotGameState = BotGameState {+ bgsTree :: GameNode Double,+ bgsColour :: Colour+}++instance Show BotGameState where+ show (BotGameState tree _) = show $ treeGameState tree++runBot :: Bot b => b -> IO ()+runBot bot = do+ infoM (botName bot) "Starting up."+ playTakClient (botHandle bot) (BotState Nothing)++handle :: Bot b => b -> PlayTakClient -> PlayTakMsg -> BotState -> IO BotState++handle bot ptc Welcome state = do+ client ptc (botName bot)+ return state++handle bot ptc PleaseLogin state = do+ login ptc (botName bot) (botPassword bot)+ return state++handle bot ptc (LoggedIn _) state = do+ infoM (botName bot) "Logged in"+ seekIfNeeded bot ptc state+ return state++handle _ _ (SeekNew _ _ _ _) state = do+ return state++handle _ _ (SeekRemove _ _ _ _) state = do+ return state++handle bot ptc (GameStart game size player1 player2 colour) state = do+ infoM (botName bot) $ "Starting game: " ++ player1 ++ " vs " ++ player2+ infoM (botName bot) $ "Size is " ++ show size ++ ", we are " ++ show colour+ let botGameState = newGame bot size colour White+ state' = state{bstGame = Just (game, botGameState)}+ state'' <- if ourmove botGameState+ then makePlay bot ptc state'+ else return state'+ return state''+ +handle bot ptc (PlayMsg gameno p) state = do+ let (gameno', botGameState) = fromJustNote "Game not started" $ bstGame state+ GameNode gameState _ branches = bgsTree botGameState+ gameTree' = headNote ("Unexpected play: " ++ listPlays) $ catMaybes $ map tree branches+ where+ listPlays = show $ map (\ (GameBranch p2 _) -> p2) branches+ tree (GameBranch p2 node)+ | p == p2 = Just node+ | otherwise = Nothing+ gameState' = treeGameState gameTree'+ botGameState' = botGameState{bgsTree = gameTree'}+ state' = state{bstGame = Just (gameno, botGameState')}+ if gameno /= gameno'+ then error "Wrong game number"+ else return ()+ infoM (botName bot) $ "Their move: " ++ ptn (stBoard gameState) p+ infoM (botName bot) $ show gameState'+ if stFinished gameState' == Nothing+ then makePlay bot ptc state'+ else return state'++handle _ _ OK state = do+ return state++handle _ _ (Online _) state = do+ return state++handle _ _ (Shout _ _) state = do+ return state++handle _ _ (GameListAdd _ _ _ _ _ _ _ _) state = do+ return state++handle _ _ (GameListRemove _ _ _ _ _ _ _ _) state = do+ return state++handle _ _ (Time _ _ _) state = do+ return state++handle bot ptc (Abandon _) state = do+ infoM (botName bot) $ "Game abandoned"+ seekIfNeeded bot ptc state+ return $ state{bstGame = Nothing}++handle bot ptc (Over _ p1 p2) state = do+ infoM (botName bot) $ "Game over: " ++ show p1 ++ "-" ++ show p2+ seekIfNeeded bot ptc state+ return $ state{bstGame = Nothing}++handle bot _ msg state = do+ warningM (botName bot) $ "Unhandled message '" ++ show msg ++ "'."+ return state++seekIfNeeded :: Bot b => b -> PlayTakClient -> BotState -> IO ()+seekIfNeeded bot ptc _ = do+ infoM (botName bot) "Seeking new game"+ {-if stOpponent state == Nothing+ then seek client 5 (30 * 60) 0 Nothing+ else return ()-}+ seek ptc 5 (30 * 60) 0 Nothing++makePlay :: Bot b => b -> PlayTakClient -> BotState -> IO BotState+makePlay bot ptc state = do+ let (gameno, botGameState) = fromJustNote "Game not started" $ bstGame state+ (next, botGameState', score) = botChoosePlay bot botGameState+ tree = bgsTree botGameState+ gameState = treeGameState tree+ tree' = bgsTree botGameState'+ gameState' = treeGameState tree'+ -- infoM "Takky" $ "Possible plays: " ++ concatMap show (possiblePlays gameState)+ infoM (botName bot) $ "My move: " ++ ptn (stBoard gameState) next+ infoM (botName bot) $ show gameState'+ infoM (botName bot) $ "Score: " ++ show score+ sendPlay ptc gameno next+ if stFinished gameState' /= Nothing+ then infoM (botName bot) "Game over"+ else do+ let (next', _, _) = botChoosePlay bot botGameState'+ infoM (botName bot) $ "Predicted move: " ++ ptn (stBoard gameState') next'+ return $ state{bstGame = Just (gameno, botGameState')}++newGame :: Bot b => b -> Int -> Colour -> Colour -> BotGameState+newGame bot size colour playsFirst =+ BotGameState (gameTree (initialState size playsFirst) (botEvaluate bot colour)) colour++ourmove :: BotGameState -> Bool+ourmove (BotGameState (GameNode state _ _) colour) = stPlaysNext state == colour++{-noErr :: (Either GameState IllegalMove) -> GameState+noErr (Left state) = staet+noErr (Right err) = error $ show err-}
+ src/Tak.hs view
@@ -0,0 +1,16 @@+module Tak (+ GameNode(..),+ GameBranch(..),+ module Tak.Types,+ initialState,+ gameTree,+ treeGameState,+ ptn,+ parsePtn+) where++import Tak.Init+import Tak.ShowPTN+import Tak.ParsePTN+import Tak.Tree+import Tak.Types
+ src/Tak/ApplyPlay.hs view
@@ -0,0 +1,113 @@+module Tak.ApplyPlay where++import Data.Matrix hiding (trace)++import Tak.Types+import Tak.Win++play :: Play -> GameState -> Either GameState IllegalMove+play _ (GameState _ _ _ (Just finished) _ _) = Right (GameAlreadyWon finished)+play (Place stone loc) state+ | fst loc > nrows board = Right $ ExceededBounds PosX+ | fst loc < 1 = Right $ ExceededBounds NegX+ | snd loc > ncols board = Right $ ExceededBounds PosY+ | snd loc < 1 = Right $ ExceededBounds NegY+ | otherwise = case square of+ [] -> Left $ GameState newBoard newWhite newBlack finished+ (oppositeColour $ stPlaysNext state) (stNextTurn state + 1)+ _ -> Right SquareNotEmpty+ where+ finished = won newBoard newWhite newBlack+ newBoard = setElem [(stone, colour)] loc board+ newWhite = case colour of+ White -> removeStone stone (stWhite state)+ Black -> stWhite state+ newBlack = case colour of+ White -> stBlack state+ Black -> removeStone stone (stBlack state)+ removeStone Flat player =+ player{stonesRemaing = stonesRemaing player - 1}+ removeStone Standing player = removeStone Flat player+ removeStone Cap player =+ player{capsRemaining = capsRemaining player - 1}+ square = board ! loc+ board = stBoard state+ colour = if stNextTurn state <= 2+ then oppositeColour $ stPlaysNext state+ else stPlaysNext state+play (Move loc dir drops) state+ | carry > carryLimit board = Right CarryLimitExceeded+ | carry > length square = Right StackTooSmall+ | length square == 0 = Right EmptySquare+ | snd (head square) /= colour = Right WrongColourStack+ | fst loc > nrows board = Right $ ExceededBounds PosX+ | fst loc < 1 = Right $ ExceededBounds NegX+ | snd loc > ncols board = Right $ ExceededBounds PosY+ | snd loc < 1 = Right $ ExceededBounds NegY+ | otherwise = case newBoardOrErr of+ Left newBoard -> Left state{stBoard = newBoard,+ stPlaysNext = oppositeColour colour,+ stNextTurn = stNextTurn state + 1,+ stFinished = won newBoard (stWhite state) (stBlack state)+ }+ Right err -> Right err+ where+ newBoardOrErr = foldr place (Left boardSub) (zip dropPieces dropLocs)+ dropPieces = snd $ foldl dropPieces' (carried, []) drops+ dropPieces' (carriedLeft, dropsSoFar) n =+ let (ds, carriedLeft') = splitAt n carriedLeft in + (carriedLeft', dropsSoFar ++ [reverse ds])+ dropLocs = map (step loc dir) [1..]+ boardSub = setElem (drop carry square) loc board+ carried = reverse $ take carry square+ carry = sum drops+ square = board ! loc+ board = stBoard state+ colour = stPlaysNext state++place :: ([Piece], Loc) -> (Either Board IllegalMove) -> Either Board IllegalMove+place stackLoc (Left board) = place' stackLoc board+place _ illegalMove = illegalMove++place' :: ([Piece], Loc) -> Board -> (Either Board IllegalMove)+place' (stack, loc) board+ | fst loc > nrows board = Right $ ExceededBounds PosX+ | fst loc < 1 = Right $ ExceededBounds NegX+ | snd loc > ncols board = Right $ ExceededBounds PosY+ | snd loc < 1 = Right $ ExceededBounds NegY+ | otherwise = case square of+ [] -> Left newBoard+ (Standing, _) : _-> case stack of+ (Cap, _) : [] -> Left $ newSquashedBoard+ _ -> Right PlaceOnStanding+ (Cap, _) : _ -> Right PlaceOnCapstone+ (Flat, _) : _ -> Left newBoard+ where+ newBoard = setElem newStack loc board+ newSquashedBoard = setElem newSquashedStack loc board+ newStack = stack ++ square+ newSquashedStack = stack ++ squashedSquare+ squashedSquare = case square of+ (Standing, colour) : ss -> (Flat, colour) : ss+ _ -> square+ square = board ! loc++carryLimit :: Board -> Int+carryLimit board = max (nrows board) (ncols board)++step :: Loc -> Dir -> Int -> Loc +step (x, y) PosX n = (x + n, y)+step (x, y) NegX n = (x - n, y)+step (x, y) PosY n = (x, y + n)+step (x, y) NegY n = (x, y - n)++data IllegalMove =+ SquareNotEmpty+ | ExceededBounds Dir+ | CarryLimitExceeded+ | StackTooSmall+ | GameAlreadyWon Finished+ | PlaceOnStanding+ | PlaceOnCapstone+ | WrongColourStack+ | EmptySquare deriving Show
+ src/Tak/Init.hs view
@@ -0,0 +1,31 @@+module Tak.Init (+ initialState,+ emptyBoard,+ initialPlayer+) where++import Data.Matrix++import Tak.Types++initialState :: Int -> Colour -> GameState+initialState size playsFirst = GameState {+ stBoard = emptyBoard size,+ stWhite = initialPlayer size,+ stBlack = initialPlayer size,+ stFinished = Nothing,+ stPlaysNext = playsFirst,+ stNextTurn = 1+}++emptyBoard :: Int -> Board+emptyBoard size = matrix size size (\ _ -> [])++initialPlayer :: Int -> Player+initialPlayer 3 = Player 0 10+initialPlayer 4 = Player 0 15+initialPlayer 5 = Player 1 21+initialPlayer 6 = Player 1 30+initialPlayer 7 = Player 2 40+initialPlayer 8 = Player 2 50+initialPlayer i = error $ "No rules for board size " ++ show i
+ src/Tak/ParsePTN.hs view
@@ -0,0 +1,69 @@+module Tak.ParsePTN (parsePtn) where++import Data.List+import Data.Maybe+import Text.Parsec+import Safe++import Tak.Types++parsePtn :: String -> Either ParseError Play+parsePtn str = parse ptn "" str++type Parser a = Parsec String () a++ptn :: Parser Play+ptn = try move <|> place++place :: Parser Play+place = do+ ms <- optionMaybe stone+ (x, y) <- loc+ return $ Place (fromJustDef Flat ms) (x, y)++move :: Parser Play+move = do+ mc <- optionMaybe int+ (x, y) <- loc+ d <- dir+ drops <- many int+ let drops' = case drops of+ [] -> case mc of+ Nothing -> [1]+ Just c -> [c]+ _ -> drops+ optional $ stone >> return ()+ return $ Move (x, y) d drops'++dir :: Parser Dir+dir = posx <|> negx <|> posy <|> negy where+ posx = char '>' >> return PosX+ negx = char '<' >> return NegX+ posy = char '+' >> return PosY+ negy = char '-' >> return NegY++stone :: Parser Stone+stone = flat <|> standing <|> cap where+ flat = char 'F' >> return Flat+ standing = char 'S' >> return Standing+ cap = char 'C' >> return Cap++loc :: Parser (Int, Int)+loc = do+ r <- rank+ f <- file+ return (r, f)++rank :: Parser Int+rank = do+ let chars = "abcdefghijklmnopqrstuvwxyz" + c <- oneOf chars+ return $ (fromJust $ elemIndex c chars) + 1++file :: Parser Int+file = int++int :: Parser Int+int = do+ i <- digit+ return $ read [i]
+ src/Tak/PossiblePlays.hs view
@@ -0,0 +1,66 @@+module Tak.PossiblePlays (+ possiblePlays,+ possiblePlacements,+ possibleMoves,+ stackMoves+) where++import Data.Matrix hiding (trace)+import Data.Maybe++import Tak.ApplyPlay+import Tak.Types++-- | Lists the possible next plays that could happen in a game.+possiblePlays :: GameState -> [Play]+possiblePlays state+ | stNextTurn state <= 2 = possiblePlacements state+ | stFinished state == Nothing =+ possiblePlacements state ++ possibleMoves state+ | otherwise = []++-- | Lists the possible placement moves a player could make.+possiblePlacements :: GameState -> [Play]+possiblePlacements state = foldr fn [] (squareIndices board) where+ fn index plays = mapMaybe (placement board index) pieces ++ plays+ pieces = catMaybes $ maybeCap : maybeStone+ maybeCap+ | stNextTurn state <= 2 = Nothing+ | capsRemaining player > 0 = Just Cap+ | otherwise = Nothing+ maybeStone+ | stNextTurn state <= 2 = [Just Flat]+ | stonesRemaing player > 0 = [Just Flat, Just Standing]+ | otherwise = []+ board = stBoard state+ player = stNextPlayer state++-- | Creates a placement move on a square if possible.+placement :: Board -> (Int, Int) -> Stone -> Maybe Play+placement board index piece = case (board ! index) of+ [] -> Just $ Place piece index+ _ -> Nothing++possibleMoves :: GameState -> [Play]+possibleMoves state = foldr fn [] (squareIndices board) where+ fn index plays = case (board ! index) of+ [] -> plays+ square @ ((_, colour') : _) -> if (colour == colour')+ then stackMoves state index square ++ plays+ else plays+ colour = stPlaysNext state+ board = stBoard state++stackMoves :: GameState -> Loc -> Square -> [Play]+stackMoves state index square = filter legalMove moves where+ legalMove move = case play move state of+ Left _ -> True+ Right _-> False+ moves = concatMap movesDir dirs+ movesDir dir = map (Move index dir) (concatMap drops carry)+ dirs = map toEnum [0 .. 3]+ drops :: Int -> [[Int]]+ drops 0 = [[]]+ drops limit = concatMap (\ i -> map (i : ) (drops (limit - i))) [1 .. limit]+ carry = [1 .. maxCarry]+ maxCarry = min (length square) (carryLimit $ stBoard state)
+ src/Tak/ShowPTN.hs view
@@ -0,0 +1,34 @@+module Tak.ShowPTN (ptn) where++import Data.Matrix++import Tak.Types++ptn :: Board -> Play -> String+ptn _ (Place stone loc) = (stoneCode stone) ++ (strLoc loc)+ptn board (Move loc dir drops) = carry ++ (strLoc loc) ++ (dirCode dir)+ ++ (dropCode drops) ++ stoneCode (fst $ head $ board ! loc) where+ carry+ | total > 1 = show total+ | otherwise = ""+ total = sum drops+ dirCode PosX = ">"+ dirCode NegX = "<"+ dirCode PosY = "+"+ dirCode NegY = "-"+ dropCode (_ : []) = ""+ dropCode ds = concatMap show ds++strLoc :: (Int, Int) -> String+strLoc (x, y) = file x ++ rank y++file :: Int -> String+file i = ["abcdefghijklmnopqrstuvwxyz" !! (i - 1)]++rank :: Int -> String+rank i = show i++stoneCode :: Stone -> String+stoneCode Flat = ""+stoneCode Standing = "S"+stoneCode Cap = "C"
+ src/Tak/Tree.hs view
@@ -0,0 +1,63 @@+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
+ src/Tak/Types.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverlappingInstances,+ DeriveGeneric #-}+module Tak.Types (+ Board,+ Square,+ Piece,+ Stone(..),+ Colour(..),+ Play(..),+ Dir(..),+ Loc,+ GameState(..),+ Player(..),+ stNextPlayer,+ Finished(..),+ oppositeColour,+ squareIndices+) where++import Prelude hiding (concatMap, elem, foldr)++import Data.Foldable+import Data.Hashable+import Data.Matrix hiding (trace)+import GHC.Generics (Generic)+import Text.ParserCombinators.ReadPrec+import Text.Read++type Board = Matrix Square+type Square = [Piece]+type Piece = (Stone, Colour)+data Stone = Cap | Flat | Standing deriving (Eq, Generic, Read, Show)+instance Hashable Stone+data Colour = Black | White deriving (Eq, Generic)+instance Hashable Colour+data Play = Place Stone Loc | Move Loc Dir [Int] deriving (Eq, Read, Show)+data Dir = PosX | NegX | PosY | NegY deriving (Enum, Eq, Read, Show)+type Loc = (Int, Int)++data Player = Player {+ capsRemaining :: Int,+ stonesRemaing :: Int+} deriving (Generic, Eq, Show)+instance Hashable Player++data GameState = GameState {+ stBoard :: Board,+ stWhite :: Player,+ stBlack :: Player,+ stFinished :: Maybe Finished,+ stPlaysNext :: Colour,+ stNextTurn :: Int+} deriving (Generic, Eq)++instance Show GameState where+ show state = show (stBoard state)+ ++ "White: " ++ show (stWhite state) ++ "\n"+ ++ "Black: " ++ show (stBlack state) ++ "\n"+ ++ "Finished: " ++ show (stFinished state) ++ "\n"+ ++ show (stPlaysNext state) ++ " to play next, in turn "+ ++ show (stNextTurn state)++instance Hashable Board where+ hashWithSalt salt board = foldr (flip hashWithSalt) salt board+ --hashSquareWithSalt salt [] = hashWithSalt salt (0 :: Int)+ --hashSquareWithSalt salt (x : _) = hashWithSalt salt x++instance Hashable GameState where+ hashWithSalt salt state =+ salt `hashWithSalt` (stPlaysNext state) `hashWithSalt` (stBoard state)++stNextPlayer :: GameState -> Player+stNextPlayer state = case stPlaysNext state of+ White -> stWhite state+ Black -> stBlack state++data Finished =+ RoadWin Colour+ | FlatWin Colour Int Int+ | Draw Int Int deriving (Eq, Generic, Show)+instance Hashable Finished++{-data BoardSize = BoardSize {+ boardX :: Int,+ boardY :: Int,+ maxCarry :: Int+}-}++instance Read Board where+ readPrec = do+ rows <- many readRow+ let entries = concatMap (splitRow (length rows)) rows+ entries' = map (dropWhile (== ' ')) entries+ entries'' = map read entries'+ return $ fromList (length rows) (length rows) entries''+ where+ readRow = do+ char '('+ row <- charsNotIn ")"+ char ')'+ char '\n'+ return row+ splitRow count row =+ splitRow' ((length row - 1) `div` count) count [] row + splitRow' _ 0 entries _ = entries+ splitRow' splitPoint count entries row = do+ let (entry, rest) = splitAt splitPoint row+ splitRow' splitPoint (count - 1) (entries ++ [entry]) rest++char :: Char -> ReadPrec ()+char expected = do+ c <- get+ if c == expected then return () else pfail++many :: ReadPrec a -> ReadPrec [a]+many parser = (many' []) <++ (return []) where+ many' sofar = do+ a <- parser+ (many' (sofar ++ [a])) <++ (return $ sofar ++ [a])++charsNotIn :: String -> ReadPrec String+charsNotIn chars = charsNotIn' "" where+ charsNotIn' sofar = do+ c <- get+ if c `elem` chars+ then pfail+ else do+ (charsNotIn' $ sofar ++ [c]) <++ return (sofar ++ [c])++instance Show Square where+ show square = concatMap show square++instance Read Square where+ readPrec = readPieces [] <++ return []+ where+ readPieces sofar = readPieces' sofar <++ return sofar+ readPieces' sofar = do+ piece <- readPrec+ readPieces $ sofar ++ [piece]++instance Show Piece where+ show (Flat, colour) = show colour+ show (Standing, colour) = "S" ++ show colour+ show (Cap, colour) = "C" ++ show colour++instance Read Piece where+ readPrec = standing_or_cap <++ flat+ where+ flat = do+ c <- readPrec+ return (Flat, c)+ standing_or_cap = do+ stone <- get+ c <- readPrec+ case stone of+ 'S' -> return (Standing, c)+ 'C' -> return (Cap, c)+ _ -> pfail++instance Show Colour where+ show Black = "X"+ show White = "O"++instance Read Colour where+ readPrec = do+ c <- get+ case c of+ 'X' -> return Black+ 'O' -> return White+ _ -> pfail+ +oppositeColour :: Colour -> Colour+oppositeColour Black = White+oppositeColour White = Black++squareIndices :: Matrix a -> [(Int, Int)]+squareIndices board = [(i, j) | i <- [1 .. nrows board], j <- [1 .. ncols board]]
+ src/Tak/Win.hs view
@@ -0,0 +1,71 @@+module Tak.Win (+ won,+ territory,+ roadWin+) where++import qualified Data.Foldable as Foldable+import Data.Matrix hiding (trace)++import Tak.Types++won :: Board -> Player -> Player -> Maybe Finished+won board white black = case roadWin board of+ Just win -> Just win+ Nothing -> flatWin board white black++flatWin :: Board -> Player -> Player -> Maybe Finished+flatWin board white black+ | finished && wc > bc = Just $ FlatWin White wc bc+ | finished && wc < bc = Just $ FlatWin Black wc bc+ | finished && wc == bc = Just $ Draw wc bc+ | otherwise = Nothing+ where+ (wc, bc, em) = territory board+ finished = empty white || empty black || em == 0+ empty player = stonesRemaing player == 0 && capsRemaining player == 0++-- | Counts the squares owned by white and black, and empty squares, respectively.+territory :: Board -> (Int, Int, Int)+territory board = Foldable.foldr fn (0, 0, 0) board where+ fn ((Flat, White) : _) (wc, bc, empty) = (wc + 1, bc, empty)+ fn ((Flat, Black) : _) (wc, bc, empty) = (wc, bc + 1, empty)+ fn [] (wc, bc, empty) = (wc, bc, empty + 1)+ fn _ (wc, bc, empty) = (wc, bc, empty)++-- | Lists which colour owns each square, in a road-building sense.+owner :: Board -> Matrix (Maybe Colour)+owner board = fmap squareOwner board where+ squareOwner [] = Nothing+ squareOwner ((Standing, _) : _) = Nothing+ squareOwner ((Flat, colour) : _) = Just colour+ squareOwner ((Cap, colour) : _) = Just colour++roadWin :: Board -> Maybe Finished+roadWin board+ | xwinW || ywinW = Just $ RoadWin White+ | xwinB || ywinB = Just $ RoadWin Black+ | otherwise = Nothing+ where+ (xwinW, _) = foldr (roadFrom White PosX o) (False, unseen) (sides PosX)+ (xwinB, _) = foldr (roadFrom Black PosX o) (False, unseen) (sides PosX)+ (ywinW, _) = foldr (roadFrom White PosY o) (False, unseen) (sides PosY)+ (ywinB, _) = foldr (roadFrom Black PosY o) (False, unseen) (sides PosY)+ sides :: Dir -> [Loc]+ sides PosX = [(1, i) | i <- [1 .. ncols board]]+ sides NegX = sides PosX+ sides PosY = [(i, 1) | i <- [1 .. nrows board]]+ sides NegY = sides PosY+ unseen = fmap (\ _ -> False) board+ o = owner board++roadFrom :: Colour -> Dir -> Matrix (Maybe Colour) -> Loc -> (Bool, Matrix Bool) -> (Bool, Matrix Bool)+roadFrom _ _ _ _ (True, seen) = (True, seen)+roadFrom colour dir own loc@(i, j) (_, seen)+ | i < 1 || j < 1 || i > nrows own || j > ncols own = (False, seen)+ | seen ! loc = (False, seen)+ | own ! loc /= (Just colour) = (False, setElem True loc seen)+ | dir == PosX && i == nrows own = (True, seen)+ | dir == PosY && j == ncols own = (True, seen)+ | otherwise = foldr (roadFrom colour dir own) (False, (setElem True loc seen))+ [(i + 1, j), (i - 1, j), (i, j - 1), (i, j + 1)]
+ src/tests.hs view
@@ -0,0 +1,141 @@+module Main where++import Data.Matrix hiding (trace)+import Test.HUnit++import Tak.ApplyPlay+import Tak.Init+import Tak.ParsePTN+import Tak.PossiblePlays+import Tak.Types+import Tak.Win++test_simple_move :: Test+test_simple_move = TestCase $ assertEqual "moves" expectedMoves+ (possibleMoves gameState')+ where+ expectedMoves = parseMoves ["a1>", "a1+"]+ gameState = initialState 5 White+ gameState' = noPlayError $ play play1 gameState+ play1 = noParseError $ parsePtn "a1"++test_stack_move :: Test+test_stack_move = TestCase $ assertEqual "moves" expectedMoves+ (possibleMoves gameState')+ where+ expectedMoves = parseMoves [+ "b2>", "2b2>11", "2b2>2",+ "b2<", "2b2<2",+ "b2+", "2b2+11", "2b2+2",+ "b2-", "2b2-2"]+ gameState = initialState 5 White+ gameState' = gameState{stBoard = setElem+ [(Flat, White), (Flat, White)] (2, 2) (stBoard gameState)}++test_roadwin :: Test+test_roadwin = TestCase $ assertEqual "roadwin" Nothing+ (roadWin board)+ where+ board = fromList 5 5 [+ [], [], [], [], [],+ [], [], [], [(Flat, Black)], [],+ [], [], [], [(Flat, Black)], [],+ [], [], [], [(Flat, Black)], [],+ [], [], [], [(Flat, Black)], []]++test_roadwin2 :: Test+test_roadwin2 = TestCase $ assertEqual "roadwin" (Just $ RoadWin Black)+ (roadWin board)+ where+ board = fromList 5 5 [+ [], [], [], [(Flat, Black)], [],+ [], [], [], [(Flat, Black)], [],+ [], [], [], [(Flat, Black)], [],+ [], [], [], [(Flat, Black)], [],+ [], [], [], [(Flat, Black)], []]++test_stack_move_result :: Test+test_stack_move_result = TestCase $ assertEqual "stack_move" expectedBoard+ (stBoard $ noPlayError $ play (parseMove "4b4>22") gameState)+ where+ gameState = (initialState 5 Black){stBoard = board}+ board = fromList 5 5 [+ [], [], [], [], [],+ [], [], [], [(Cap, Black), (Flat, Black), (Flat, White), (Flat, Black)], [],+ [], [], [], [], [],+ [], [], [], [], [],+ [], [], [], [], []]+ expectedBoard = fromList 5 5 [+ [], [], [], [], [],+ [], [], [], [], [],+ [], [], [], [(Flat, White), (Flat, Black)], [],+ [], [], [], [(Cap, Black), (Flat, Black)], [],+ [], [], [], [], []]++test_stack_move_result2 :: Test+test_stack_move_result2 = TestCase $ assertEqual "stack_move" expectedBoard+ (stBoard $ noPlayError $ play (parseMove "4b4>31") gameState)+ where+ gameState = (initialState 5 Black){stBoard = board}+ board = fromList 5 5 [+ [], [], [], [], [],+ [], [], [], [(Cap, Black), (Flat, Black), (Flat, White), (Flat, Black)], [],+ [], [], [], [], [],+ [], [], [], [], [],+ [], [], [], [], []]+ expectedBoard = fromList 5 5 [+ [], [], [], [], [],+ [], [], [], [], [],+ [], [], [], [(Flat, Black), (Flat, White), (Flat, Black)], [],+ [], [], [], [(Cap, Black)], [],+ [], [], [], [], []]++test_stack_move_legal :: Test+test_stack_move_legal = TestCase $ assert $ parseMove "5d2+122C" `elem` moves where+ moves = possibleMoves state+ --moves = stackMoves state (4, 2) (board ! (4, 2))+ state = GameState board player player Nothing White 3+ board = read $+ "( X )\n" +++ "( )\n" ++ + "( XXX )\n" +++ "( COXOOOO XO )\n" +++ "( XOOO O OXXO )\n"+ player = Player 1 0++test_roadwin3 :: Test+test_roadwin3 = TestCase $ assert $ roadWin board == Just (RoadWin White) where+ board = read $+ "( CX O X X )\n" +++ "( X OXXX )\n" +++ "( O O )\n" +++ "( O )\n" +++ "( O )\n"++parseMoves :: [String] -> [Play]+parseMoves = map parseMove++parseMove :: String -> Play+parseMove = noParseError . parsePtn++noParseError :: (Show a) => Either a t -> t+noParseError (Right p) = p+noParseError (Left err) = error $ show err++noPlayError :: Show a => Either t a -> t+noPlayError (Left state) = state+noPlayError (Right err) = error $ show err++tests :: Test+tests = TestList [TestLabel "test_simple_move" test_simple_move,+ TestLabel "test_stack_move" test_stack_move,+ TestLabel "test_roadwin" test_roadwin,+ TestLabel "test_roadwin2" test_roadwin2,+ TestLabel "test_stack_move_result" test_stack_move_result,+ TestLabel "test_stack_move_result2" test_stack_move_result2,+ TestLabel "test_stack_move_legal" test_stack_move_legal,+ TestLabel "test_roadwin3" test_roadwin3]++main :: IO Counts+main = do+ runTestTT tests
+ tak.cabal view
@@ -0,0 +1,50 @@+name: tak+version: 0.1.0.0+synopsis: A library encoding the rules of Tak, and a playtak.com client.+description:+ Tak is a new abstract strategy game, devised by James Earnest (of Cheapass+ Games), and Patrick Rothfuss, author of The Wise Man's Fear, where the game of+ Tak was first mentioned.++ This is a library which encodes the rules of Tak, provides a client for the+ popular playtak.com server, and contributes an AI tak bot for the same server.++ This package provides 3 top level modules:++ Tak encodes the rules of Tak, as a game tree, containing all possible moves.+ This tree is extremely large, so be careful not to strictly evaluate it!++ PlayTak provides functions for maintaining a connection to playtak.com, receiving+ messages, and sending commands. This could be used to implement a+ fully-fledged game client, or a playtak.com bot.++ PlayTakBot is a framework to make it easy to build a playtak.com bot. It will+ maintain a connection, seek games, and create a game tree. The bot implementor+ just needs to provide functions to evaluate a game state, and choose the next+ play from each game state.++homepage: http://bitbucket.org/sffubs/tak+license: BSD2+license-file: LICENSE+author: Henry Bucklow+maintainer: henry@elsie.org.uk+-- copyright: +category: Game+build-type: Simple+cabal-version: >=1.8++library+ hs-source-dirs: src+ exposed-modules: Tak, PlayTak, PlayTakBot+ other-modules: Tak.ApplyPlay, Tak.Init, Tak.ParsePTN, Tak.PossiblePlays,+ Tak.ShowPTN, Tak.Tree, Tak.Types, Tak.Win+ PlayTak.Commands, PlayTak.Parser, PlayTak.Types+ ghc-options: -Wall -O2+ build-depends: base < 5, matrix, network, safe, parsec, hslogger, bytestring, random-shuffle, hashable+ +test-suite tests+ hs-source-dirs: src+ ghc-options: -Wall+ type: exitcode-stdio-1.0+ main-is: tests.hs+ build-depends: base < 5, matrix, network, safe, parsec, hslogger, bytestring, random-shuffle, hashable, HUnit