{-# LANGUAGE RankNTypes, ConstraintKinds, FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-}
module Network.Anticiv.Modules.Mafia.Core where

import Prelude hiding (log)
import Control.Monad
import Data.List
import Data.Typeable
import Data.Chatty.Atoms
import Data.Chatty.AVL
import Data.Chatty.BST
import Network.Anticiv.Convenience
import Network.Anticiv.Modules.Mafia.Data
import Network.Anticiv.Monad
import System.Chatty.Misc
import Text.Printf

data MafiaState = MafiaState {
    mafiaInitiator :: UserA,
    mafiaPlayers :: AVL (UserA,PlayerState),
    voteScore :: AVL ((Subject,PlayerId),Int),
    votedAlready :: [(Subject,PlayerId)],
    mafiaDone :: Bool,
    triadDone :: Bool,
    partyDay :: Int,
    actionsDone :: AVL Card,
    safeTonight :: [PlayerId],
    lostHandlers :: [HandlerA],
    isNight :: Bool,
    coupledPlayers :: Maybe (PlayerId, PlayerId)
  }
type MafiaStateA = Atom MafiaState

data PlayerState = PlayerState {
    playerAlive :: Bool,
    playerCards :: [Card],
    playerRoles :: [Role],
    playerSaved :: Bool
  } | NopeNotYet deriving Eq

data FinishReason = Deathmatch | JustinWon deriving (Eq,Ord,Show)

data Subject = Execution | MafiaKill | TriadKill deriving (Eq,Ord,Show)

-- | Phantom type. Just to make sure. If a function gets a 'PlayerId' passed,
-- we're already sure it is contained in 'mafiaPlayers' and don't need to
-- handle the 'Nothing' case any more, as it is already handled in 'toPID'.
newtype PlayerId = UnsafePlayerId { fromPID :: UserA } deriving (Eq,Ord)

toPID :: MafiaStateA -> UserA -> Anticiv (Maybe PlayerId)
toPID msa ua = do
  ms <- mafiaPlayers #< msa
  return $ case avlLookup ua ms of
    -- It's safe here :)
    Just _ -> Just $ UnsafePlayerId ua
    Nothing -> Nothing

withPID :: MafiaStateA -> UserA -> (PlayerId -> Anticiv ()) -> Anticiv ()
withPID msa ua f = do
  mpid <- toPID msa ua
  case mpid of
    Just pid -> f pid
    Nothing -> do
      u <- userNick #< ua
      globalfl "DoesntParticipate" u

withAlivePID :: MafiaStateA -> UserA -> (PlayerId -> Anticiv ()) -> Anticiv ()
withAlivePID msa ua f = withPID msa ua $ \pid -> do
  al <- playerAlive &< (msa,pid)
  when al $ f pid
  unless al $ do
    u <- userNick #< ua
    globalfl "IsDead" u

withInitiator :: MafiaStateA -> UserA -> (PlayerId -> Anticiv ()) -> Anticiv ()
withInitiator msa ua f = withPID msa ua $ \pid -> do
  mi <- mafiaInitiator #< msa
  if mi == ua
     then f pid
     else addressfl ua "NotPermitted"

forAllPlayers_ :: MafiaStateA -> (PlayerId -> Anticiv ()) -> Anticiv ()
forAllPlayers_ msa f = void $ forAllPlayers msa f

forAllPlayers :: MafiaStateA -> (PlayerId -> Anticiv a) -> Anticiv [a]
forAllPlayers msa f = do
  pv <- mafiaPlayers #< msa
  forM (filter (playerAlive.snd) $ avlInorder pv) $ \(u,_) -> f $ UnsafePlayerId u

forAllMafiosi :: MafiaStateA -> (PlayerId -> Anticiv a) -> Anticiv [a]
forAllMafiosi msa f = forAllPred msa (shareFaction Rom) f

forAllMafiosi_ :: MafiaStateA -> (PlayerId -> Anticiv ()) -> Anticiv ()
forAllMafiosi_ msa f = void $ forAllMafiosi msa f

forAllTriadists :: MafiaStateA -> (PlayerId -> Anticiv a) -> Anticiv [a]
forAllTriadists msa f = forAllPred msa (shareFaction Rot) f

forAllTriadists_ :: MafiaStateA -> (PlayerId -> Anticiv ()) -> Anticiv ()
forAllTriadists_ msa f = void $ forAllTriadists msa f

forAllPred :: MafiaStateA -> (Role -> Bool) -> (PlayerId -> Anticiv a) -> Anticiv [a]
forAllPred msa pred f = liftM concat $ forAllPlayers msa $ \pid -> do
  b <- (msa, pid) %| pred
  if b then liftM return $ f pid else return []

forAllPred_ :: MafiaStateA -> (Role -> Bool) -> (PlayerId -> Anticiv ()) -> Anticiv ()
forAllPred_ msa pred f = void $ forAllPred msa pred f

-- | Tries to match a predicate on any of the player's roles
(%|) :: (MafiaStateA, PlayerId) -> (Role -> Bool) -> Anticiv Bool
(msa,pid) %| f = do
  rs <- playerRoles &< (msa, pid)
  return $ any f rs

-- | Runs a function on the most important of the player's roles
(%&) :: (MafiaStateA, PlayerId) -> (Role -> a) -> Anticiv a
(msa,pid) %& f = do
  rs <- playerRoles &< (msa, pid)
  -- actually it's the maximum, but the sort order is reversed
  return $ f $ minimumBy (\a b -> rolePriority a `compare` rolePriority b) rs

-- | Like %&, but makes sure the observation reveals an oblique result
(%|&) :: (MafiaStateA, PlayerId) -> (Role -> a) -> Anticiv a
(msa,pid) %|& f = do
  rs <- playerRoles &< (msa, pid)
  return $ f $
    minimumBy (\a b -> rolePriority a `compare` rolePriority b) $
    filter ((/=Transparent) . observation) rs

-- | Like %&, but takes another player
(%&&) :: (MafiaStateA, PlayerId) -> (Role -> Role -> a) -> PlayerId -> Anticiv a
(msa,a) %&& f = \b -> do
  rs <- playerRoles &< (msa, b)
  (msa,a) %& f `ap` return (minimumBy (\a b -> rolePriority a `compare` rolePriority b) rs)

seekRole :: Faction f => MafiaStateA -> f -> Anticiv [PlayerId]
seekRole m r = liftM join $ forAllPlayers m $ \p -> do
  b <- seekCard m p r
  if null b then return [] else return [p]

seekUnusedRole :: Faction f => MafiaStateA -> f -> Anticiv [PlayerId]
seekUnusedRole m r = liftM join $ forAllPlayers m $ \p -> do
  b <- seekUnusedCard m p r
  if null b then return [] else return [p]

seekCard :: Faction f => MafiaStateA -> PlayerId -> f -> Anticiv [Card]
seekCard m pid r = do
  cs <- playerCards &< (m,pid)
  return $ intersect (getRoleCards r) cs

seekUnusedCard :: Faction f => MafiaStateA -> PlayerId -> f -> Anticiv [Card]
seekUnusedCard m pid r = do
  cs <- seekCard m pid r
  ad <- actionsDone #< m
  liftM join $
    forM cs $
    \c -> return $
    case avlLookup c ad of
      Just _ -> []
      Nothing -> [c]
  
isMafioso :: MafiaStateA -> PlayerId -> Anticiv Bool
isMafioso msa pid = (msa, pid) %| shareFaction Rom

isTriadist :: MafiaStateA -> PlayerId -> Anticiv Bool
isTriadist msa pid = (msa, pid) %| shareFaction Rot

pget :: MafiaStateA -> PlayerId -> Anticiv PlayerState
pget msa pid = do
  ms <- mafiaPlayers #< msa
  case avlLookup (fromPID pid) ms of
    -- There can only be Just, thanks to phantom magic
    Just ps -> return ps

pgets :: MafiaStateA -> PlayerId -> (PlayerState -> a) -> Anticiv a
pgets msa pid f = liftM f $ pget msa pid

pput :: MafiaStateA -> PlayerId -> PlayerState -> Anticiv ()
pput msa pid ps = do
  ms <- id #< msa
  ms{mafiaPlayers=avlInsert (fromPID pid, ps) $ mafiaPlayers ms} #> msa

pmodify :: MafiaStateA -> PlayerId -> (PlayerState -> PlayerState) -> Anticiv ()
pmodify msa pid f = pgets msa pid f >>= pput msa pid

joinParty :: MafiaStateA -> UserA -> Anticiv PlayerId
joinParty msa ua = do
  -- It's safe here :)
  NopeNotYet &> (msa, UnsafePlayerId ua)
  return $ UnsafePlayerId ua

(#>) :: a -> Atom a -> Anticiv ()
v #> a = putAtom a v

(#<) :: (a -> b) -> Atom a -> Anticiv b
f #< a = liftM f $ getAtom a

(<>#) :: Atom a -> (a -> a) -> Anticiv ()
a <># f = getAtom a >>= putAtom a . f

(<>&) :: (MafiaStateA,PlayerId) -> (PlayerState -> PlayerState) -> Anticiv ()
(msa,pid) <>& f = pmodify msa pid f

(&>) :: PlayerState -> (MafiaStateA,PlayerId) -> Anticiv ()
ps &> (msa,pid) = pput msa pid ps

(&<) :: (PlayerState -> a) -> (MafiaStateA,PlayerId) -> Anticiv a
f &< (msa,pid) = pgets msa pid f

selectRoles :: Int -> Anticiv [RoleCard]
selectRoles ntotal = do
  drjustin <- liftM (==1) $ mrandomR (1,5 :: Int)
  drterrorist <- liftM (==1) $ mrandomR (1,5 :: Int)
  drchurch <- liftM (==1) $ mrandomR (1,5 :: Int)
  drvampire <- liftM (==1) $ mrandomR (1,5 :: Int)
  drtriad <- liftM (==1) $ mrandomR (1,8 :: Int)
  let nmaffs = round (fromIntegral ntotal / 3.5)
      ntriad = if drtriad then min (round (fromIntegral ntotal / 3.5)) 3 else 0
      ncivics = ntotal
                - nmaffs
                - ntriad
                - length (filter id [drjustin{-,drterrorist,drchurch,drvampire-}])
  maffs <- chooseN nmaffs $ proposeCards (bogus MafiaK) nmaffs
  triad <- chooseN ntriad $ proposeCards (bogus TriadK) ntriad
  civics <- chooseN ncivics $ proposeCards (bogus CivicK) ncivics
  justin <- if drjustin then chooseN 1 $ proposeCards (bogus JustinK) 1 else return []
  --terrorist <- if drterrorist then chooseN 1 $ proposeCards (bogus TerroristK) 1 else return []
  --church <- if drchurch then chooseN 1 $ proposeCards (bogus ChurchK) 1 else return []
  --vampire <- if drvampire then chooseN 1 $ proposeCards (bogus VampireK) 1 else return []
  let total = maffs ++ civics ++ justin ++ triad
      tjudges = filter (\(c :-> r) -> r `elem` [CivicK CitJudge,MafiaK MaffJudge,TriadK TriJudge]) total
  if length tjudges <= 1
    then return (maffs ++ civics ++ justin ++ triad)
    else selectRoles ntotal -- new try

chooseN :: Int -> [RoleProposal] -> Anticiv [RoleCard]
chooseN 0 _ = return []
chooseN _ [] = return []
chooseN n cs = do
  let m = sum $ map (\(Propose i _) -> i) cs
      retr i (Propose p r:ps)
        | i < p = Propose p r
        | otherwise = retr (i-p) ps
  r <- mrandomR (0,m-1)
  let pr@(Propose _ cr) = retr r cs
  crs <- chooseN (n-1) (delete pr cs)
  return (cr : crs)

-- | That's Fisher-Yates, if I remember correctly
shuffle :: [a] -> Anticiv [a]
shuffle [] = return []
shuffle as = do
  r <- mrandomR (0, length as - 1)
  let i = as !! r
      ax = take r as ++ drop (r+1) as
  is <- shuffle ax
  return (i:is)

assignRoles :: MafiaStateA -> Anticiv ()
assignRoles msa = do
  pv <- mafiaPlayers #< msa
  let psc = avlSize pv
      ps = avlInorder pv
  rs <- shuffle =<< selectRoles psc
  log $ printf "Just to make sure: We have %i players and %i roles." psc (length rs)
  forM_ (zip ps rs) $ \((u,_), c :-> r) ->
    PlayerState True [c] [r] False &> (msa, UnsafePlayerId u)

hasVoted :: MafiaStateA -> PlayerId -> Subject -> Anticiv Bool
hasVoted msa pid sub = do
  var <- votedAlready #< msa
  case filter (==(sub,pid)) var of
    [] -> return False
    _ -> return True

playerVote :: MafiaStateA -> PlayerId -> PlayerId -> Subject -> Speaker -> Anticiv Bool
playerVote msa el vi sub speak = do
  var <- hasVoted msa el sub
  case var of
    True -> do
      speak (fromPID el) "AlreadyVoted" :: Anticiv ()
      return False
    False -> do
      msa <># \m -> m{votedAlready=(sub,el) : votedAlready m}
      vsc <- voteScore #< msa
      case avlLookup (sub,vi) vsc of
        Nothing -> msa <># \m -> m{voteScore=avlInsert ((sub,vi),1) vsc}
        Just i -> msa <># \m -> m{voteScore=avlInsert ((sub,vi),i+1) vsc}
      return True

partyFinished :: MafiaStateA -> Anticiv Bool
partyFinished msa =
  liftM (all and) $
  forAllPlayers msa $
  \a -> forAllPlayers msa $
  \b -> (msa, a) %&& winsWith $ b

actionDone :: Faction f => MafiaStateA -> PlayerId -> f -> Anticiv ()
actionDone msa pid r = do
  cs <- seekUnusedCard msa pid r
  case cs of
    [] -> log "Wait, what?"
    c:_ -> msa <># \m -> m{actionsDone=avlInsert c $ actionsDone m}

instance Indexable (Atom a) (Atom a) (Atom a) where
  valueOf = id
  indexOf = id

instance Indexable PlayerId PlayerId PlayerId where
  valueOf = id
  indexOf = id

instance Indexable Card Card Card where
  valueOf = id
  indexOf = id