diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/src/PlayTak.hs b/src/PlayTak.hs
new file mode 100644
--- /dev/null
+++ b/src/PlayTak.hs
@@ -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'
diff --git a/src/PlayTak/Commands.hs b/src/PlayTak/Commands.hs
new file mode 100644
--- /dev/null
+++ b/src/PlayTak/Commands.hs
@@ -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"
diff --git a/src/PlayTak/Parser.hs b/src/PlayTak/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/PlayTak/Parser.hs
@@ -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 ()
diff --git a/src/PlayTak/Types.hs b/src/PlayTak/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/PlayTak/Types.hs
@@ -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
diff --git a/src/PlayTakBot.hs b/src/PlayTakBot.hs
new file mode 100644
--- /dev/null
+++ b/src/PlayTakBot.hs
@@ -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-}
diff --git a/src/Tak.hs b/src/Tak.hs
new file mode 100644
--- /dev/null
+++ b/src/Tak.hs
@@ -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
diff --git a/src/Tak/ApplyPlay.hs b/src/Tak/ApplyPlay.hs
new file mode 100644
--- /dev/null
+++ b/src/Tak/ApplyPlay.hs
@@ -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
diff --git a/src/Tak/Init.hs b/src/Tak/Init.hs
new file mode 100644
--- /dev/null
+++ b/src/Tak/Init.hs
@@ -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
diff --git a/src/Tak/ParsePTN.hs b/src/Tak/ParsePTN.hs
new file mode 100644
--- /dev/null
+++ b/src/Tak/ParsePTN.hs
@@ -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]
diff --git a/src/Tak/PossiblePlays.hs b/src/Tak/PossiblePlays.hs
new file mode 100644
--- /dev/null
+++ b/src/Tak/PossiblePlays.hs
@@ -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)
diff --git a/src/Tak/ShowPTN.hs b/src/Tak/ShowPTN.hs
new file mode 100644
--- /dev/null
+++ b/src/Tak/ShowPTN.hs
@@ -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"
diff --git a/src/Tak/Tree.hs b/src/Tak/Tree.hs
new file mode 100644
--- /dev/null
+++ b/src/Tak/Tree.hs
@@ -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
diff --git a/src/Tak/Types.hs b/src/Tak/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Tak/Types.hs
@@ -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]]
diff --git a/src/Tak/Win.hs b/src/Tak/Win.hs
new file mode 100644
--- /dev/null
+++ b/src/Tak/Win.hs
@@ -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)]
diff --git a/src/tests.hs b/src/tests.hs
new file mode 100644
--- /dev/null
+++ b/src/tests.hs
@@ -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
diff --git a/tak.cabal b/tak.cabal
new file mode 100644
--- /dev/null
+++ b/tak.cabal
@@ -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