Haskell Minimax with Alpha-Beta Pruning

AlphaBetaPruning.hs

-- tree type for minimaxing, empty subtree list indicates a leaf node
data Tree a = Node a [Tree a]
              deriving Show

-- minimax assumes a two-player game
data Player = One | Two
              deriving Eq

-- moves to the next player
next :: Player -> Player
next One = Two
next Two = One

-- gets the value in a node
val :: Tree a -> a
val (Node x _) = x

-- checks and updates the value of alpha and beta respectively
checkalpha :: (a -> Int) -> Int -> Int -> Int -> [Tree a] -> [Tree Int]
checkalpha f v a b ts | b <= alpha = maxprune f alpha b []
                      | otherwise  = maxprune f alpha b ts
                      where alpha = max a v

checkbeta :: (a -> Int) -> Int -> Int -> Int -> [Tree a] -> [Tree Int]
checkbeta f v a b ts | beta <= a = minprune f a beta []
                     | otherwise = minprune f a beta ts
                     where beta = min b v

-- mutually recursive functions for maximum and minimum respectively
maxprune :: (a -> Int) -> Int -> Int -> [Tree a] -> [Tree Int]
maxprune _ _ _ []     = []
maxprune f a b (t:ts) = tree : checkalpha f (val tree) a b ts
                        where tree = abprune f Two a b t

minprune :: (a -> Int) -> Int -> Int -> [Tree a] -> [Tree Int]
minprune _ _ _ []     = []
minprune f a b (t:ts) = tree : checkbeta f (val tree) a b ts
                        where tree = abprune f One a b t

-- minimaxes with alpha-beta pruning
abprune :: (a -> Int) -> Player -> Int -> Int -> Tree a -> Tree Int
abprune f _   _ _ (Node x []) = Node (f x) []
abprune f One a b (Node _ ts) = Node (maximum [val t | t <- subtrees]) subtrees
                                where subtrees = maxprune f a b ts
abprune f Two a b (Node _ ts) = Node (minimum [val t | t <- subtrees]) subtrees
                                where subtrees = minprune f a b ts

{-- TESTING
alpha :: Int
alpha = minBound
beta :: Int
beta = maxBound

neg :: Int -> Int
neg x = -x
testtree :: Tree Int
testtree = Node 3 [Node 3 [Node 3 [Node (neg 1) [], Node 3 []], Node 5 [Node 5 [], Node 0 []]], 
                   Node (neg 4) [Node (neg 4) [Node (neg 6) [], Node (neg 4) []], Node 0 [Node 0 [], Node 0 []]]]

countnode :: Tree a -> Int
countnode (Node _ []) = 1
countnode (Node _ ts) = 1 + sum (map countnode ts)
--}