PossiblePlays.hs

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)