{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}

-- | Provides utility functions for dealing with stats and stereotypes
module Game.Antisplice.Stats where

import Control.Monad
import Control.Monad.Identity
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Rooms
import Game.Antisplice.Utils.AVL
import Game.Antisplice.Utils.Atoms
import Text.Chatty.Printer

-- | Typeclass for every pure data that saves stats
class HasStats s where
  -- | Set the given key to the given value
  setStat :: StatKey -> Int -> s -> s
  -- | Lookup the given key
  getStat :: StatKey -> s -> Int

-- | Typeclass for every monad that saves stats
class HasStatsM m where
  -- | Set the given key to the given value
  setStatM :: StatKey -> Int -> m ()
  -- | Lookup the given key
  getStatM :: StatKey -> m Int

instance HasStats ObjectState where
  setStat k v o = o{objectStatsOf=avlInsert (k,v) $ objectStatsOf o}
  getStat k o = case avlLookup k $ objectStatsOf o of
    Nothing -> 0
    Just v -> v

instance Monad m => HasStatsM (ObjectT m) where
  setStatM k v = modifyObjectState $ setStat k v
  getStatM k = (return . getStat k) =<< getObjectState

instance HasStats PlayerState where
  setStat k v p = p{playerBaseStatsOf=avlInsert (k,v) $ playerBaseStatsOf p}
  getStat k p = case avlLookup k $ playerBaseStatsOf p of
    Nothing -> 0
    Just v -> v

instance Monad m => HasStatsM (PlayerT m) where
  setStatM k v = modifyPlayerState $ setStat k v
  getStatM k = (return . getStat k) =<< getPlayerState

-- | Sum the stats of the objects the player carries (ignoring base stats and boni)
sumStat :: MonadPlayer m => StatKey -> m Int
sumStat k = do
  s <- getPlayerState
  let is = map (getStat k) $ avlInorder $ playerInventoryOf s
  let es = map (getStat k.snd) $ avlInorder $ playerEquipOf s
  return (sum is + sum es + getStat k s)

-- | Calculates the stats of the objects the player carries
calcStat :: (Functor m,MonadPlayer m,MonadAtoms m,MonadRoom m,MonadPrinter m) => StatKey -> m Int
calcStat k = do
  p <- getPlayerState
  r <- getRoomState
  let ss k = fst $ runIdentity $ runPlayerT (sumStat k) p
      steseg (StereoSeg a) = [a]
      steseg _ = []
      rsegs = map steseg $ concatMap objectNearImplicationsOf $ avlInorder $ roomObjectsOf r
      isegs = map steseg $ concatMap objectCarryImplicationsOf $ avlInorder $ playerInventoryOf p
      --wsegs = map steseg $ concatMap objectWearImplicationOf $ avlInorder
  stes <- fmap (map stereoCalcStatBonus) $ mapM getAtom (concat rsegs ++ concat isegs ++ playerStereosOf p)
  return $ foldr (\f g k -> f g k + g k) ss stes k

-- | Default stereotype.
defaultStereo = PlayerStereo $
  \get k -> case k of
    AttackPower -> get Strength * 2
    _ -> 0

-- | Register the given stereotype and return its atom.
registerStereo :: MonadAtoms m => PlayerStereo -> m (Atom PlayerStereo)
registerStereo s = do
  a <- newAtom
  putAtom a s
  return a

-- | Add the given stereotype to the current player.
addStereo :: MonadPlayer m => Atom PlayerStereo -> m ()
addStereo a = modifyPlayerState $ \p -> p{playerStereosOf=a:playerStereosOf p}

-- | Remove one stereotype and add another
replaceStereo :: MonadPlayer m => Atom PlayerStereo -> Atom PlayerStereo -> m ()
replaceStereo rem ins = modifyPlayerState $ \p -> p{playerStereosOf=map (\a -> if a == rem then ins else a) $ playerStereosOf p}