{-# LANGUAGE   TemplateHaskell 
             , FlexibleContexts
             , RankNTypes
             , DeriveDataTypeable #-}

module Merchandise.Types.Player
       ( Player(..)
       -- Lenses
       , person
       , money
       , inventory
       , territory
       , date
       , faction
       , factionActions
       , modCS
       , location

       , newPlayer

       -- Item Stuff
       , addItem
       , remItem
         
       -- Date stuff
       , incrMonth
       , incrYear
       , advMonths
       , advYears

       -- location stuff
       , buyLocation
       , sellLocation

       -- state stuff
       , addChar
       , remChar
       , query
       , modifyCS
       ) where

import Control.Lens

import Data.Maybe    (fromMaybe)
import Data.SafeCopy
import Data.Typeable

import qualified Data.Map.Strict    as M
import qualified Data.Set           as S
import qualified Data.Text          as T
import qualified Data.Time.Calendar as D

import qualified Merchandise.Types.CoreState as CS
import qualified Merchandise.Types.Item      as I
import qualified Merchandise.Types.Location  as L
import qualified Merchandise.Types.Person    as P
import qualified Merchandise.Types.Skill     as S

type ItemID     = T.Text
type PersonID   = T.Text
type SkillID    = T.Text
type EventID    = T.Text
type LocationID = T.Text
type ActionID   = T.Text

-- refer to Data.Time.Calendar
type Date = D.Day

data Player = Player {
      _person    :: PersonID
    , _money     :: {-# UNPACK #-} !Float
    , _inventory :: I.Inventory
    , _territory :: S.Set LocationID

    , _date           :: Date

    , _faction        :: S.Set PersonID        -- all people under PC's command
    , _factionActions :: M.Map ActionID T.Text -- interactions with your faction
    
    , _modCS    :: CS.CoreState
    , _location :: LocationID
    } deriving (Show, Read, Eq, Typeable)
makeLenses ''Player
$(deriveSafeCopy 0 'base ''Player)

-- creates a new Player
newPlayer :: Player
newPlayer = Player { _person         = T.pack "player"
                   , _money          = 0.0
                   , _inventory      = I.newInventory
                   , _territory      = S.empty
                   , _date           = D.fromGregorian 642 3 1 -- yyyy/mm/dd
                   , _faction        = S.empty
                   , _factionActions = M.empty
                   , _modCS          = CS.newCoreState
                   , _location       = T.empty
                   }

-- | Add an item to a Player's inventory
addItem :: I.Item -> Player -> Player
addItem i = inventory %~ I.addItem i

-- | Remove an item from a Player's inventory
remItem :: I.Item -> Player -> Player
remItem i = inventory %~ I.removeItem i

-- the Player attempts to purchase a Location. Fails (with a Left Text) if the
-- Player already the location, cannot afford the location, or if the location
-- is not ownable.
buyLocation :: L.Location -> Player -> Either T.Text Player
buyLocation loc pl
    | playerOwnsIt =
        Left $ T.pack "Player already owns this location."
    | notOwnable =
        Left $ T.pack "This location cannot be purchased."
    | cantAfford =
        Left $ T.pack "Player cannot afford this location."
    | otherwise =
        Right $ pl & money -~ (loc ^. L.price)
                   & territory %~ S.insert (loc ^. L.locID)
  where
    playerOwnsIt = not $ S.notMember (loc ^. L.locID) (pl  ^. territory)
    notOwnable   = not $ loc ^. L.ownable
    cantAfford   = not $ (pl ^. money) >= (loc ^. L.price)

-- the Player sells a Location, if the Player owns the Location
sellLocation :: L.Location -> Player -> Either T.Text Player
sellLocation loc pl =
    case (pl ^. territory . contains (loc ^. L.locID)) of
      True  -> Right $ pl & territory . contains (loc ^. L.locID) .~ False
                          & money +~ (loc ^. L.price)
      False -> Left $ T.pack "Player does not own this Location."

-- | Increments the Date by one month.
incrMonth :: Date -> Date
incrMonth = D.addGregorianMonthsClip 1

-- | Increments the Date by one Year.
incrYear :: Date -> Date
incrYear = D.addGregorianYearsClip 1

-- | Synonym for addGregorianMonthsClip
advMonths :: Integer -> Date -> Date
advMonths = D.addGregorianMonthsClip

-- | Synonym for addGregorianYearsClip
advYears :: Integer -> Date -> Date
advYears = D.addGregorianYearsClip

-- | Adds a Person to the Player's faction
addChar :: T.Text -> Player -> Player
addChar pid = faction . contains pid .~ True

-- | Removes a Person from the Player's faction
remChar :: T.Text -> Player -> Player
remChar pid = faction . contains pid .~ False

-- looks for k in store l in Player p. If found, return the value. Else,
-- repeat the procedure, but looking in CoreState g.
query :: Lens' CS.CoreState (M.Map T.Text a)
      -> T.Text
      -> CS.CoreState
      -> Player
      -> Maybe a
query l k g p = case M.lookup k (p^.modCS^.l) of
  Just x  -> Just x
  Nothing -> case M.lookup k (g^.l) of
    Just x  -> Just x
    Nothing -> Nothing

-- modifies the Player's CoreState. It first checks to see if the desired
-- record is within Player, and if so, modifies it. If not, then it pulls the
-- record from the independent CoreState, modifies it, and put it into
-- Player's CoreState. If the record DNE, then return the unmodified Player.
-- Usage with lenses (CS.world, CS.people, CS.skills, CS.items):
-- modifyCS lens function id gamestate player
modifyCS :: Lens' CS.CoreState (M.Map T.Text a)
         -> (a -> a)
         -> T.Text
         -> CS.CoreState
         -> Player
         -> Player
modifyCS l f k g p = case M.member k (p^.modCS^.l) of
  True  -> p & modCS %~ CS.modifyAt l f k
  False -> case M.lookup k (g^.l) of
    Just x  -> p & modCS %~ CS.addTo l k (f x)
    Nothing -> p
