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)
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
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
(%|) :: (MafiaStateA, PlayerId) -> (Role -> Bool) -> Anticiv Bool
(msa,pid) %| f = do
rs <- playerRoles &< (msa, pid)
return $ any f rs
(%&) :: (MafiaStateA, PlayerId) -> (Role -> a) -> Anticiv a
(msa,pid) %& f = do
rs <- playerRoles &< (msa, pid)
return $ f $ minimumBy (\a b -> rolePriority a `compare` rolePriority b) rs
(%|&) :: (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
(%&&) :: (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
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
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])
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 []
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
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 (ip) ps
r <- mrandomR (0,m1)
let pr@(Propose _ cr) = retr r cs
crs <- chooseN (n1) (delete pr cs)
return (cr : crs)
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