module Praks6 where
   
import Test.HUnit 
import Data.Maybe
import Data.List (minimumBy, maximumBy)
import System.IO 

{- 
Puu [Tree a b] on struktuur, kus on märgendatud 
kõik tipud [a] ja kõik servad [b] tüüpidega. 
-}
data Tree a b = Node a [(b,Tree a b)] deriving (Show,Eq)


{- 
[root tr] tagastab selle puu juurtipu väärtuse 
-}
root ::  Tree a b -> a
root (Node x _) = x


{- 
Trips-traps-trulli mängija esitus -- kas rist või ring.
-}
data Player = X | O deriving (Eq,Show)


{-
[other p] väärtus on [p] vastu mänija.
-}
other :: Player -> Player
other X = O
other O = X


{- 
[Pos] on laua koordinaadi tüüp.
-}
type    Pos   = (Int,Int)


{-  
[Board] on mängulaua tüüp --- list paaridest [(pos,pl)], kus 
[pos] on laua koordinaat ja [pl] on mängija tähis, mis seal asub.
-}
newtype Board = Board [(Pos,Player)] 

{- Mängulaudade samasus -}
instance Eq Board where
  b1 == b2 = all (\ p -> get p b1 == get p b2) [(x,y)| x <- [0..2], y<-[0..2]]

{- 
Mänguväljaku tekstiks muutmine (enamasti väljatrüki jaoks)
-}
instance Show Board where
    show brd = "\n"++
        sh (0,0) ++ "|" ++ sh (1,0) ++ "|" ++ sh (2,0) ++ "\n" ++ 
        "-+-+-\n" ++
        sh (0,1) ++ "|" ++ sh (1,1) ++ "|" ++ sh (2,1) ++ "\n" ++
        "-+-+-\n" ++
        sh (0,2) ++ "|" ++ sh (1,2) ++ "|" ++ sh (2,2) ++ "\n"    
	        where
            sh pos = maybe " " show (get pos brd)

---------------------------------------------------

{- tühi laud -}
empty_board :: Board 
empty_board = Board []


{-
[set pos pl brd] puhul muudetake laua seisu 
nii, et positsioonis [pos] oleks uue laua 
seisus [pl] väärtus 
-}
set :: Pos -> Maybe Player -> Board -> Board

set pos (Just p) (Board xs) 
  | notElem (pos, X) xs && notElem (pos, O) xs = Board $ (pos, p) : xs
  | otherwise = Board $ xs
set pos (Nothing) (Board xs) = Board ( filter (\ (x,_) -> pos /= x) xs )

{-
[get pos brd] väärtus on [Nothing], kui 
vastav positsioon laual oli tühi, ja 
[Just p] kui positisoonil oli mängija [p]. 
-}
get :: Pos -> Board -> Maybe Player 

get pos (Board []) = (Nothing)
get pos (Board xs) = f (filter (\ (x,y) -> pos == x) xs) where
  f [] = (Nothing)
  f [(pos, p)] = (Just p)



test1 = runTestTT tests
  where tests = test [empty_board_test,get_set_board_test]
        empty_board_test    = "empty_board"   ~: [Nothing ~=? get (x,y) empty_board | x <- [0..2], y <-[0..2] ]
        get_set_board_test  = "get_set_board" ~: [v ~=? get (x,y) (set (x,y) v empty_board) | x <- [0..2], y <-[0..2], v <-[Just X,Just O,Nothing] ]

{- 
  [possible_moves brd] väärtuseks on positisoonide 
  list, kuhu mängija saab käia
-}
possible_moves :: Board -> [Pos]

possible_moves (Board []) = [(x,y) | x <- [0..2], y <- [0..2] ]
possible_moves (Board xs) = [(x,y) | x <- [0..2], y <- [0..2], isNothing $ get (x,y) (Board xs) ]


test2 = runTestTT tests
  where tests = test [empty_board_test,nonempty_board_test]
        empty_board_test    = "empty_board moves" ~: ((9    ~=? length (possible_moves empty_board)) :
                                                      [True ~=? (elem (x,y) (possible_moves empty_board)) | x <- [0..2], y <-[0..2]])
        nonempty_board_test = "nonempty moves "   ~: [False ~=? (elem (x,y) $ possible_moves (set (x,y) v empty_board)) | x <- [0..2], y <-[0..2], v <-[Just X,Just O] ]

-----------------------------------------------------------

{- 
  [winning brd] tagastab Nothing, kui kumbki mängija pole 
  selle mänguväljakul võitnud, ja [Just p] kui mängija [p] on võitnud.
-}

-- All possible winning combinations:
patterns :: [ [Pos] ]
patterns =  [ 
	      -- Diagonal:
              [(0,0), (1,1), (2,2)],
              [(2,0), (1,1), (0,2)],
	      -- Horizontal:
              [(0,0), (1,0), (2,0)],
              [(0,1), (1,1), (2,1)],
              [(0,2), (1,2), (2,2)],
	      -- Vertical:
              [(0,0), (0,1), (0,2)],
              [(1,0), (1,1), (1,2)],
              [(2,0), (2,1), (2,2)]
            ]

--check_player_pattern :: Board -> Maybe Player -> [Pos] -> Bool
--check_player_pattern (Board []) (Just p) xs = False
--check_player_pattern (Board brd) (Just p) [] = False
--check_player_pattern (Board brd) (Just p) (x:y:z:ws) = (get x (Board brd)) == (Just p) && 
--                                                       (get y (Board brd)) == (Just p) && 
--                                                       (get z (Board brd)) == (Just p)
--
--winning :: Board -> Maybe Player
--winning (Board []) = Nothing
--winning (Board xs)
--  | any (check_player_pattern (Board xs) (Just X)) patterns == True = Just X
--  | any (check_player_pattern (Board xs) (Just O)) patterns == True = Just O
--  | otherwise = Nothing

-- version 2
winning :: Board -> Maybe Player
winning (Board []) = Nothing
winning (Board xs)
  | or $ map (all $ \p -> Just X == get p (Board xs)) patterns = Just X
  | or $ map (all $ \p -> Just O == get p (Board xs)) patterns = Just O
  | otherwise = Nothing


test3 = runTestTT tests
  where tests = test [empty_board_test,x_wins_board_test,o_wins_board_test]
        empty_board_test  = "empty_board wins?" ~: ( Nothing  ~=? winning empty_board ) 
        x_wins_board_test = "x_wins_board_test" ~: ( Just X   ~=? winning (foldr (flip set (Just X)) empty_board  [(0,0),(1,1),(2,2)])) 
        o_wins_board_test = "o_wins_board_test" ~: ( Just O   ~=? winning (foldr (flip set (Just O)) empty_board  [(1,0),(1,1),(1,2)])) 

----------------------------------------------------------

{- 
  [full_tree_at brd plr] väärtus on täielik mängupuu, kus 
  juureks on etteantud mänguvälja ja mängija paar [(brd,plr)]. 
  
  See tähendab, et iga tipu [(brd,plr)] lapstipud on kõik, ühe käiguga saadud 
  tipust [brd] nii, et käib mängija [plr].
-}
full_tree_at :: Board -> Player -> Tree (Board,Player) Pos
full_tree_at (Board xs) player
  | winning (Board xs) /= Nothing = Node ((Board xs), player) []
  | otherwise = Node ((Board xs), player) $ map all_moves (possible_moves (Board xs)) where
      all_moves x = ((x), full_tree_at (set (x) (Just player) (Board xs)) (other player))



test4 = runTestTT tests
  where tests = test [finite_tree_test,a_step_test,b_step_test]
        finite_tree_test  = "tree finite?" ~: ( Node (x_end  ,X) []  ~=? full_tree_at x_end   X) 
        a_step_test       = "one step"     ~: ( (x_end_1,O)  ~=? (root $ full_tree_at x_end_1 O)) 
        b_step_test       = "one step"     ~: ( 7 ~=? let (Node _ bs) = full_tree_at x_end_1 X in length bs) 
        x_end   = foldr (flip set (Just X)) empty_board  [(0,0),(1,1),(2,2)]
        x_end_1 = foldr (flip set (Just X)) empty_board  [(0,0),(1,1)]


{-  Täielik mängupuu tühjast lauast, kusjuures esimese kõigu teeb X -}
full_tree :: Tree (Board,Player) Pos
full_tree = full_tree_at empty_board X



{- Laua lõppseisu "headus" X suhtes. -}
val :: Board -> Int
val brd = case winning brd of
            Just X  ->  1
            Just O  -> -1
            Nothing ->  0

{- 
Laua mitte-lõppseisu "headus" X suhtes. 

Idee poolest leiab see parima valiku hetkel käivale mängijale iga võimalikku käiku arvestades.
-}
min_or_max :: Player -> [Int] -> Int
min_or_max X = foldl1 (\ x y -> if x ==   1  then x else max x y)  
min_or_max O = foldl1 (\ x y -> if x == (-1) then x else min x y)  
            

{- 
Täielik mängupuu, nagu [full_tree] kuid paar [(brd,plr)] on asendatud 
lõppseisu puhul [val brd] ja mitte-lõppseisu puhul väärtusega [min_or_max plr xs],
kus [xs] on antud tipu lapstippude väärtused.

Kasutab [full_tree]-d
-}
weighed_tree :: Tree Int Pos

weighed_tree = f full_tree where
  f :: Tree (Board, Player) Pos -> Tree Int Pos
  f (Node (brd, plr) []) = Node (val brd) []
  f (Node (brd, plr) xs) = Node (min_or_max plr $ map (root.snd) nxs) nxs where 
    nxs = map ( \(p,t) -> (p, f t) ) xs



test5 = runTestTT tests
  where tests = test [win_test_1,win_test_2,win_test_3]
        win_test_1  = "simple win" ~: (1 ~=? root x_end) 
        win_test_2  = "good cases" ~: (1 ~=? let (Node _ xs) = x_end in length $ filter ((<1) . root . snd) xs) 
        win_test_3  = "bad cases"  ~: (4 ~=? let (Node _ xs) = x_end in length $ filter ((>=1) . root . snd) xs) 
        wh_goto (Node _ xs) pos = fromJust $ lookup pos xs 
        x_end      = foldl wh_goto weighed_tree [(0,0),(1,0),(1,1),(2,0)]


--------------


getPlayerResponse :: Board -> IO Pos
getPlayerResponse brd = do putStr "sisesta koordinaandid (0..2,0..2): "
                           ln <- getLine
                           case readsPrec 0 ln of
                               [((x,y),[])] -> if elem x [0..2] && elem y [0..2] && (isNothing $ get (x,y) brd)
                                               then return $ (x,y)
                                               else getPlayerResponse brd
                               otherwise    -> getPlayerResponse brd 
                           


--------

gameLoop :: Player -> Board -> Tree Int Pos -> IO ()
gameLoop plr brd (Node _ fr) = do (pos,tr) <- case plr of
                                                 O -> return $ minimumBy (\ x y -> compare (root $ snd x) (root $ snd y))  fr
                                                 X -> do pos <- getPlayerResponse brd
                                                         case lookup pos fr of
                                                            Just tr -> return (pos,tr)
                                                            Nothing -> error "tree was not complete"
                                  let new_brd = set pos (Just plr) brd
                                  putStrLn $ show  new_brd
                                  case winning new_brd of
                                    Just X  -> putStrLn "X võitis"
                                    Just O  -> putStrLn "O võitis"
                                    Nothing -> case tr of
                                                  (Node _ []) -> putStrLn "Viik!"
                                                  tr          -> gameLoop (other plr) new_brd tr 


--------

main = do hSetBuffering stdin LineBuffering
          hSetBuffering stdout NoBuffering
          putStr $ show empty_board
          gameLoop X empty_board weighed_tree