module Rules where

import GameBoard
import Types

import Data.List
import Test.QuickCheck


distance (Loc (x1,y1)) (Loc (x2,y2)) = max dx dy
    where dx = abs $ x2 - x1
          dy = abs $ y2 - y1

-- List of squares in a straight line between 
-- two co-ordinates in the landscape.
path (Loc (x1,y1)) (Loc (x2,y2)) = zipWith (\x y -> Loc (x,y)) [x1+dx..x2] [y1+dy..y2]
    where dx = signum $ x2 - x1
          dy = signum $ y2 - y1
-- Check that all squares on the route between
-- two points are vacant.
openpath start end b = all (flip vacant b) (path start end)
accessible (Loc (x1,y1)) (Loc (x2,y2)) = x1==x2 || y1==y2 || abs(x2-x1)==abs(y2-y1)

-- Check that a particular move is valid for this
-- piece on this board. (Essentially, the "rules".)
valid (Move Troll start end) b = distance start end == 1 && vacant end b
valid (Move Dwarf start end) b = openpath start end b && accessible start end
valid (Toss Troll start end back) b =
    let ts = all (`elem` trolls b) $ path start back
        es = openpath start end b
        ds = dwarves b `union` nearby end
    in distance start back >= distance start end && ts && es && not (null ds)
valid (Toss Dwarf start end back) b =
    let ds = all (`elem` dwarves b) $ path start back
        (t:es) = path start end
    in distance start back >= distance start end && accessible start end && accessible end back && accessible start back &&
        ds && t`elem`trolls b && all (flip vacant b) es

-- Move the piece if it's valid (and optionally kill
-- off other pieces if moving a troll).
move m b = if valid m b then kill m (shift m b) else b

-- If moving a troll, kill all adjacent dwarves when
-- we end up at our final square.
kill (Move Troll _ e) b = b {dwarves = dwarves b \\ nearby e}
kill _ b = b
-- Change the location of the piece being moved, leaving
-- behind an empty spot.
shift (Move Troll s e) b = b {trolls = delete s (e:trolls b)}
shift (Move Dwarf s e) b = b {dwarves = delete s (e:dwarves b)}
shift (Toss Troll s e _) b = b {trolls = delete s (e:trolls b)}
shift (Toss Dwarf s e _) b = b {dwarves = delete s (e:trolls b)}

instance Arbitrary Piece where
    arbitrary = elements [Troll,Dwarf]
    coarbitrary = undefined
instance Arbitrary Square where
    arbitrary = do piece <- arbitrary
                   elements [Occupied piece, ThudStone, Empty, Offside]
    coarbitrary = undefined
instance Arbitrary Location where
    arbitrary = elements $ filter onside fullboard
    coarbitrary = undefined
instance Arbitrary Action where
    arbitrary = do start <- arbitrary
                   back  <- arbitrary
                   end   <- arbitrary
                   piece <- arbitrary
                   elements [Move piece start end, Toss piece start end back]
    coarbitrary = undefined

legalMove brd = do piece <- arbitrary
                   s <- elements $ case piece of
                                        Troll -> trolls brd
                                        Dwarf -> dwarves brd
                   e <- elements $ filter onside $ filter (flip vacant brd) $ fullboard
                   return $ Move piece s e

-- Parsing and pretty-printing squares are
-- inverses of each other for all squares.
prop_prettyid sq = sq == (parseSquare (ppSquare sq))

-- For all possible moves, a valid move leaves the
-- board in a new state.
prop_updatebrd = forAll (legalMove brd)
                        (\act -> valid act brd ==>
                            classify (trollmove act) "Troll"$
                            classify (not (trollmove act)) "Dwarf"$
                            (brd /= move act brd))
    where trollmove (Move t _ _) = t==Troll
          brd = landscape2board newLandscape