module Game
    ( GState
    , size
    , board
    , Board
    , initGState
    , deservesUndo
    , revealRec
    , flag
    , info
    , isEnd
    , isWin
    , State (..)
    , getP
    , mines
    , reveal'
--    , diff
    ) where

import Place 
import PlaceSet hiding (size, empty, insert, delete)
import qualified PlaceSet
import Core

import Numeric
import Data.Maybe
import Data.List hiding (delete, insert)
import qualified Data.List as List
import Data.Map hiding (size, singleton, map)
import qualified Data.Map as Map

import System.Random

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

isNotMineAt :: Place -> MMap -> (Rational, MMap)
isNotMineAt p m
   = (fromIntegral (solutions' m') / fromIntegral (solutions' m), m')
  where
        m' = setSum (singleton p) 0 m

degree :: Size -> Place -> MMap -> StdGen -> (Int, MMap, StdGen)
degree s p m r = (x, l !! x, r')
 where
    ps = listToPlaceSet $ neighbours s p

    (x, r') = integerDomino (map solutions' l) r

    l = [setSum ps i m | i<-[0..PlaceSet.size ps]]

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

data State 
    = Hidden !Bool (Maybe Rational)
    | Death
    | Clear Rational !Int      -- veszélyesség; szomszédos aknák száma
        deriving (Eq, Show)

-----

type Board = Map Place State

get :: Place -> Board -> State
get p b = case Map.lookup p b of
    Just s  -> s
--    _       -> Hidden

set :: Place -> State -> Board -> Board
set p s b = insert p s b

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

data GState = GS 
    { field     :: MMap
    , board_     :: Board
    , flagged   :: Int
    , cleared   :: Int
    , alive     :: Rational 
    , mines     :: Int          
    , size      :: Size
-----------
    , revMod    :: Maybe Rational
    }

deservesUndo g (g':_) | board_ g == board_ g' = 1
deservesUndo g (_:g':_) | board_ g == board_ g' = 2
deservesUndo _ _ = 0

initGState :: Size -> Int -> GState
initGState s mines_ = GS 
    { field     = setSum (places s) mines_ emptyMMap
    , board_     = Map.fromList $ zip (placeSetToList $ places s) $ repeat $ Hidden False Nothing
    , flagged   = 0
    , cleared   = 0
    , alive     = 1
    , mines     = mines_
    , size      = s
    , revMod    = Nothing
    }

reveal' :: Bool -> GState -> GState
reveal' all gs 
    = case revMod gs of
        Just 0 | all -> unreveal gs
        Just i | i > 0 && not all -> unreveal gs
        _ -> revealBoard all gs

unreveal gs | isJust (revMod gs)
    = gs { revMod = Nothing, board_ = Map.map f $ board_ gs }  where
 
    f (Hidden fl _) = Hidden fl Nothing
    f x = x
unreveal gs = gs

revealBoard all gs -- | revMod gs
    | solutions' (field gs) == 0 = gs
    | otherwise
        = gs { board_ = foldr (uncurry Map.insert) (board_ gs) b, revMod = Just $ if all then 0 else mi }  where
 
    b = concatMap h $ Map.toList $ board_ gs

    mi = maximum $ map (k . snd) b  where    k (Hidden _ (Just i)) = i

    h (p, Hidden fl _) = [(p, Hidden fl $ Just $ fst $ isNotMineAt p (field gs))]
    h _ = []

board gs 
    = case revMod gs of
        Just i | i /= 0 -> Map.map (f i) $ board_ gs
        _   -> board_ gs
 where
    f i (Hidden False (Just j)) | j /= 0 && j < i  = Hidden False Nothing
    f _ x = x


isHidden (Hidden False x) = True
isHidden _ = False

reveal :: Place -> GState -> StdGen -> (GState, StdGen)
reveal p g r
    | not $ isHidden (get p (board_ g))     = (g, r)
    | pr == 0 = (g { field = f, alive = 0, board_ = insert p Death (board_ g) }, r)
    | otherwise =  (g { field = f', board_ = insert p (Clear pr d) (board_ g), alive = pr * alive g, cleared = 1 + cleared g }, r')
 where
    (pr, f) = isNotMineAt p (field g)
    (d, f', r')= degree (size g) p f r

flag :: Place -> GState -> ([(Place, State)], GState)
flag p g = case get p $ board_ g of
    Hidden True r   -> h (Hidden False r) (-1)
    Hidden False r  | flagged g < mines g   -> h (Hidden True r) 1
    _           -> ([], g)
 where
    h x c = ([(p, x)], g { flagged = flagged g + c, board_ = set p x $ board_ g })

getP :: Place -> GState -> State
getP p g = get p (board_ g)


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

data Report 
    = Report Int Int Rational Double
        deriving Eq

instance Show Report where
    show (Report _ _ 0 _)        = "Sorry, you died of necessity."
    show (Report 0 0 x y)        = "Congratulations! You won with " ++ show_ 2 (luckinessFunction x) ++ " luckyness."
    show (Report i _ x y)        = "Mines left: " ++ show i ++ "  Information: " ++ show_ 1 (100*y) ++ "%" ++ "  Luckyness: " ++ show_ 2 (luckinessFunction x)

luckinessFunction :: Rational -> Double
luckinessFunction x = max (- log (realToFrac x) / log 4) 0

show_ :: Int -> Double -> [Char]
show_ i x = showFFloat (Just i) x ""

eval :: GState -> Report
eval g@(GS {size= s@(xS, yS)}) 
    = Report (mines g - flagged g) (xS*yS - cleared g - flagged g) (alive g) y
 where
    i = solutions' $ setSum (places s) (mines g) emptyMMap

    a = fromIntegral (solutions' $ field g) / fromIntegral i
    b = 1 / fromIntegral i

    y
        | b == 1    = 1
        | otherwise = luckinessFunction a / luckinessFunction b

isEnd :: GState -> Bool
isEnd g = case eval g of
    Report _ _ 0 _ -> True
    Report 0 0 _ _ -> True
    _              -> False

isWin :: GState -> Bool
isWin g = case eval g of
    Report 0 0 _ _ -> True
    _              -> False

info :: GState -> String
info = show . eval

-----------------------------
fff ~(x,g,r) = (x, unreveal g,r)

isFlagged (Hidden True _) = True
isFlagged _ = False

revealRec :: Place -> GState -> StdGen -> ([(Place, State)], GState, StdGen)
revealRec p g r = fff $ case getP p g of
    Clear _ x | x == sum [1 | q <- neighbours (size g) p, isFlagged (getP q g) ]  
            -> revRecL (neighbours (size g) p) g r
    _       -> revealRecS p g r

revealRecS :: Place -> GState -> StdGen -> ([(Place, State)], GState, StdGen)
revealRecS p g r = case getP p g of
    Hidden False _    -> revRec p $ reveal p g r
    _           -> ([], g, r)


revRec :: Place -> (GState, StdGen) -> ([(Place, State)], GState, StdGen)
revRec p (g, r) = strictT2 p gp  .: case gp of
    Clear _ 0   -> revRecL (neighbours (size g) p) g r
    _           -> ([], g, r)
 where
    gp = getP p g

revRecL :: [Place] -> GState -> StdGen -> ([(Place, State)], GState, StdGen)
revRecL [] g r    = ([], g, r)
revRecL (p:ps) g r = l .++ revRecL ps g' r'  where 

    ~(l, g', r') = revealRecS p g r

strictT2 a b = a `seq` b `seq` (a, b)

p .: ~(ps, g, r) = (p: ps, g, r)

l .++ ~(l', g, r) = (l ++ l', g, r)

----------

-- | Get a value from a discrete distribution with the domino algorithm.
integerDomino :: [Integer] -> StdGen -> (Int, StdGen)
integerDomino [_] r = (0, r)
integerDomino l r = (j, r')
 where
    (x, r') = randomR (1, sum l) r

    j = length $ takeWhile (<x) $ scanl1 (+) l