{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Network.Anticiv.Modules.Mafia.Data where

data CardSuit = Club | Spade | Heart | Diamond deriving (Eq,Show,Ord)
data CardValue = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Eq,Show,Ord)
data Card = Card CardSuit CardValue deriving (Eq,Show,Ord)

data RoleCard = Card :-> Role deriving (Eq,Show)
data RoleProposal = Propose Int RoleCard deriving Eq

data Role = CivicK CivicF
          | MafiaK MafiaF
          | CoupleK CoupleF
          | ChurchK ChurchF
          | VampireK VampireF
          | JustinK JustinF
          | TerroristK TerroristF
          | TriadK TriadF  
          deriving (Eq,Ord)

data Priority = Highest | High | Medium | Low | Lowest deriving (Eq,Ord)

data Observation = Friend | Enemy | Transparent deriving (Eq,Ord,Show)

class (Eq f, Ord f, Show f) => Faction f where
  factionKey :: f -> Role
  winsWith :: f -> Role -> Bool
  shareFaction :: f -> Role -> Bool
  getFactionCards :: f -> [Card]
  getRoleCards :: f -> [Card]
  proposeCards :: f -> Int -> [RoleProposal]
  rolePriority :: f -> Priority
  observation :: f -> Observation

proxy :: (forall f. Faction f => f -> a) -> Role -> a
proxy f (CivicK r) = f r
proxy f (MafiaK r) = f r
proxy f (CoupleK r) = f r
proxy f (ChurchK r) = f r
proxy f (VampireK r) = f r
proxy f (JustinK r) = f r
proxy f (TerroristK r) = f r
proxy f (TriadK r) = f r

instance Show Role where
  show = proxy show

instance Faction Role where
  factionKey f = f
  winsWith = proxy winsWith
  getFactionCards = proxy getFactionCards
  shareFaction = proxy shareFaction
  getRoleCards = proxy getRoleCards
  proposeCards = proxy proposeCards
  rolePriority = proxy rolePriority
  observation = proxy observation

data CivicF = Rop | Dimitri | Detective | Inspector | ZeroDivisor | Gardener | BusDriver | SoulSaver | Hunter | Cupid | Stoiber | Doctor | CitJudge | Tree | NPSOwner | OilTanker deriving (Eq,Ord,Show)

data MafiaF = Rom | Spy | MaffJudge deriving (Eq,Ord,Show)

data CoupleF = InLove deriving (Eq,Ord,Show)

data ChurchF = Pope | Monk deriving (Eq,Ord,Show)

data VampireF = Dracula | Vampire deriving (Eq,Ord,Show)

data JustinF = Justin deriving (Eq,Ord,Show)

data TerroristF = Terrorist | Pyromanian deriving (Eq,Ord,Show)

data TriadF = Rot | TriSpy | TriJudge deriving (Eq,Ord,Show)

propose :: Faction f => f -> [Int] -> [RoleProposal]
propose f ps =
  map (\(p,c) -> Propose p $ c :-> factionKey f) $
  zip ps $
  getRoleCards f

bogus :: Faction f => (f -> Role) -> Role
bogus f = f undefined

instance Faction CivicF where
  factionKey = CivicK
  winsWith _ (CivicK _) = True
  winsWith _ (JustinK _) = True
  winsWith _ (ChurchK _) = True
  winsWith _ _ = False
  shareFaction _ (CivicK _) = True
  shareFaction _ _ = False
  getFactionCards _ =
    [Rop,Dimitri,Detective,Inspector
    ,ZeroDivisor,Gardener,BusDriver,SoulSaver
    ,Hunter,Cupid,Stoiber,Doctor
    ,CitJudge,Tree,NPSOwner,OilTanker]
    >>= getRoleCards
  getRoleCards Rop = do
    v <- [Seven,Eight,Nine]
    s <- [Club,Spade,Heart,Diamond]
    return $ Card s v
  getRoleCards Dimitri = [Card Club Ten]
  getRoleCards Detective = [Card Spade Ace, Card Club Ace]
  getRoleCards Inspector = [Card Diamond Ace]
  getRoleCards ZeroDivisor = [Card Spade Ten]
  getRoleCards Gardener = [Card Diamond Ten]
  getRoleCards BusDriver = [Card Diamond Queen]
  getRoleCards SoulSaver = [Card Spade Queen]
  getRoleCards Hunter = [Card Spade King]
  getRoleCards Cupid = [Card Heart Queen]
  getRoleCards Stoiber = [Card Diamond King]
  getRoleCards Doctor = [Card Club Queen]
  getRoleCards CitJudge = [Card Diamond Three]
  getRoleCards Tree = [Card Club Three]
  getRoleCards NPSOwner = [Card Spade Three]
  getRoleCards OilTanker = [Card Heart Three]
  proposeCards _ _ =
    propose Rop [100,90,50,20,10,8,6,4,2,2,2,2] ++
    propose Detective [100,25] ++
    propose Inspector [25] ++
    propose Dimitri [25] ++
    propose Gardener [20] ++
    propose SoulSaver [80] ++
    propose Cupid [40]
  rolePriority _ = Low
  observation Gardener = Enemy
  observation _ = Friend

instance Faction MafiaF where
  factionKey = MafiaK
  winsWith _ (MafiaK _) = True
  winsWith _ (TerroristK _) = True
  winsWith _ _ = False
  shareFaction _ (MafiaK _) = True
  shareFaction _ _ = False
  getFactionCards _ = [Rom,Spy,MaffJudge] >>= getRoleCards
  getRoleCards Rom = Card Club Two : do
    s <- [Club,Spade,Heart,Diamond]
    return $ Card s Jack
  getRoleCards Spy = [Card Spade Two]
  getRoleCards MaffJudge = [Card Diamond Two]
  proposeCards _ _ =
    propose Rom [100, 50, 20, 10, 10] ++
    propose Spy [70] ++
    propose MaffJudge [50]
  rolePriority _ = Low
  observation _ = Enemy

instance Faction CoupleF where
  factionKey = CoupleK
  winsWith _ (CoupleK _) = True
  winsWith _ _ = False
  shareFaction _ (CoupleK _) = True
  shareFaction _ _ = False
  getFactionCards _ = []
  getRoleCards _ = []
  proposeCards _ _ = []
  rolePriority _ = Highest
  observation _ = Transparent
  
instance Faction ChurchF
instance Faction VampireF

instance Faction JustinF where
  factionKey = JustinK
  winsWith _ (JustinK _) = True
  winsWith _ (CivicK _) = True
  winsWith _ _ = False
  shareFaction _ (JustinK _) = True
  shareFaction _ _ = False
  getFactionCards _ = getRoleCards Justin
  getRoleCards Justin = [Card Heart Ten]
  proposeCards _ _ =
    propose Justin [20]
  rolePriority _ = Medium
  observation _ = Friend

instance Faction TerroristF where
  factionKey = TerroristK
  winsWith _ (TerroristK _) = True
  winsWith _ (MafiaK _) = True
  winsWith _ (TriadK _) = True
  winsWith _ _ = False
  shareFaction _ (TerroristK _) = True
  shareFaction _ _ = False
  getFactionCards _ = [Terrorist, Pyromanian] >>= getRoleCards
  getRoleCards Terrorist = [Card Club King]
  getRoleCards Pyromanian = [Card Heart Two]
  proposeCards _ _ = []
  rolePriority _ = Low
  observation _ = Enemy

instance Faction TriadF where
  factionKey = TriadK
  winsWith _ (TriadK _) = True
  winsWith _ (TerroristK _) = True
  winsWith _ _ = False
  shareFaction _ (TriadK _) = True
  shareFaction _ _ = False
  getFactionCards _ = [Rot,TriSpy,TriJudge] >>= getRoleCards
  getRoleCards Rot = [Card Club Four]
  getRoleCards TriSpy = [Card Spade Four]
  getRoleCards TriJudge = [Card Diamond Four]
  proposeCards _ _ =
    propose Rot [100] ++
    propose TriSpy [70] ++
    propose TriJudge [50]
  rolePriority _ = Low
  observation _ = Enemy