> module Macala where

Players' names are A and B:

> data Player = A | B 
>   deriving (Eq,Show)

Player state consists of score and contents of pits:

> data PState = PState Player Int [Int]
>   deriving Show

Increment a player's score:

> incScore :: Int -> PState -> PState
> incScore i (PState p s ps) = PState p (s+i) ps

Overall game state:

> data State = State PState PState
>   deriving Show

Initial state consists of 6 pits, each with 4 stones:

> initialState :: Player -> State
> initialState p = 
>   let pits = replicate 6 4
>   in State (PState p 0 pits)
>            (PState (if p==A then B else A) 0 pits)

Player whose current turn it is:

> getPlayer :: State -> Player
> getPlayer (State (PState p _ _) _) = p

Game is won when player reaches a score of 25 or more (i.e. has
captured more than half of the stones):

> isWinningState :: State -> Bool
> isWinningState (State (PState _ a _) (PState _ b _)) =
>   a > 24 || b > 24

Distribute (?) stones:

> incStones :: PState -> PState
> incStones p = distStones [1..6] p

> distStones :: [Int] -> PState -> PState
> distStones is (PState p s ps) =
>   PState p s (zipWith (\i n -> if elem i is then n+1 else n) 
>                       (iterate (+1) 1) 
>                       ps)

> incStonesBy :: Int -> PState -> PState
> incStonesBy n p = iterate incStones p !! n

> isMoveValid :: Int -> Bool
> isMoveValid n = elem n [1..6]

> isMoveLegal :: State -> Int -> Bool
> isMoveLegal _ n | not (isMoveValid n) = False
> isMoveLegal s _ | isWinningState s    = False
> isMoveLegal s n = 
>   case s of
>     (State (PState a sa pa) _) -> (pa !! (n-1)) /= 0

> applyMove :: State -> Int -> Maybe State
> applyMove s n | not (isMoveLegal s n) = Nothing
> applyMove s n = Just (applyMove' s' p')
>   where
>     (s',p') = case s of
>                 State (PState a sa pa) playerother ->
>                   (State (PState a sa (killPit pa)) playerother, 
>                    pa !! (n-1))
> 
>     killPit xs = take (n-1) xs ++ [0] ++ drop n xs
> 
>     applyMove' (State a b) p = 
>       let (rounds, extras) = divMod p 13
>           sinc             = rounds + (if (6-n) < extras then 1 else 0)
>           extras' = if n == 6
>                     then extras - 1
>                     else if null adist then 0 
>                          else extras - last adist + head adist - 2
>           extras''  = if null bdist then 0 
>                       else extras' - last bdist + (head bdist) - 1
>           adist     = [i | i <- [(n + 1)..6], i - n <= extras]
>           bdist     = [i | i <- [1..6], i <= extras']
>           adist'    = [i | i <- [1..6], i <= extras'']
>           currP = (incScore sinc . distStones adist . 
>                    distStones adist' . incStonesBy rounds) $ a
>           otherP = (distStones bdist . incStonesBy rounds) $ b
>       in if extras == 6-n+1 then State currP otherP else State otherP currP
>         --(State otherP currP)

> nextStates :: State -> [State]
> nextStates s = [s | Just s <- map (applyMove s) [1..6]]

> simulateGame :: IO ()
> simulateGame = simulateGame' (initialState A) where
>   simulateGame' st@(State (PState p s ps) b) =
>     do
>       print st
>       putStr (show p ++ ": ")
>       move <- getLine
>       let s' = applyMove st (read move)
>       case s' of
>          Nothing -> putStr "Bad Move\n"
>          Just a  -> if   isWinningState a 
>                     then putStr (show p ++ " wins!\n")
>                     else simulateGame' a

> simulateGame2 :: (State -> Int) -> IO ()
> simulateGame2 chooseMove = simulateGame' (initialState A) where
>   simulateGame' st@(State (PState p s ps) b) =
>     do
>       print st
>       putStr (show p ++ ":: ")
>       move <-
>           if p == B then
>              do move <- getLine
>                 return (read move) :: IO (Int)
>           else 
>              do let move = chooseMove st
>                 print move 
>                 return move
>       let s' = applyMove st move
>       case s' of
>          Nothing -> putStr "ERROR\n"
>          Just a  -> if isWinningState a
>                     then putStr (show p ++ " wins!\n")
>                     else simulateGame' a

> bestMove :: (Player -> State -> Int) -> State -> Int
> bestMove rating s = ...

> playComputer :: (Player->State->Int) -> IO ()
> playComputer rating = simulateGame2 (bestMove rating)

-----------------------------------------------------------------------------
-- Your code goes below here
-----------------------------------------------------------------------------