{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | The type of kinds of factions present in a game, both human
-- and computer-controlled.
module Game.LambdaHack.Content.FactionKind
  ( FactionKind(..), makeData
  , HiCondPoly, HiSummand, HiPolynomial, HiIndeterminant(..)
  , TeamContinuity(..), Outcome(..)
  , teamExplorer, hiHeroLong, hiHeroMedium, hiHeroShort, hiDweller
  , victoryOutcomes, deafeatOutcomes
  , nameOutcomePast, nameOutcomeVerb, endMessageOutcome
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateSingle, validateAll
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.Text as T
import           GHC.Generics (Generic)

import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.ContentData
import           Game.LambdaHack.Definition.Defs

-- | Properties of a particular faction.
data FactionKind = FactionKind
  { fname         :: Text        -- ^ name of the faction
  , ffreq         :: Freqs FactionKind
                                 -- ^ frequency within groups
  , fteam         :: TeamContinuity
                                 -- ^ the team the faction identifies with
                                 --   across games and modes
  , fgroups       :: Freqs ItemKind
      -- ^ names of actor groups that may naturally fall under faction's
      --   control, e.g., upon spawning; make sure all groups that may
      --   ever continuousely generate actors, e.g., through spawning
      --   or summoning, are mentioned in at least one faction kind;
      --   groups of initial faction actors don't need to be included
  , fskillsOther  :: Ability.Skills
                                 -- ^ fixed skill modifiers to the non-leader
                                 --   actors; also summed with skills implied
                                 --   by @fdoctrine@ (which is not fixed)
  , fcanEscape    :: Bool        -- ^ the faction can escape the dungeon
  , fneverEmpty   :: Bool        -- ^ the faction declared killed if no actors
  , fhiCondPoly   :: HiCondPoly  -- ^ score formula (conditional polynomial)
  , fhasGender    :: Bool        -- ^ whether actors have gender
  , finitDoctrine :: Ability.Doctrine
                                 -- ^ initial faction's non-leaders doctrine
  , fspawnsFast   :: Bool
      -- ^ spawns fast enough that switching pointman to another level
      --   to optimize spawning is a winning tactics, which would spoil
      --   the fun, so switching is disabled in UI and AI clients
  , fhasPointman  :: Bool        -- ^ whether the faction can have a pointman
  , fhasUI        :: Bool        -- ^ does the faction have a UI client
                                 --   (for control or passive observation)
  , finitUnderAI  :: Bool        -- ^ is the faction initially under AI control
  , fenemyTeams   :: [TeamContinuity]
                                 -- ^ teams starting at war with the faction
  , falliedTeams  :: [TeamContinuity]
                                 -- ^ teams starting allied with the faction
  }
  deriving (Show, Eq, Generic)

instance Binary FactionKind

-- | Team continuity index. Starting with 1. See the comment for `FactionId`.
newtype TeamContinuity = TeamContinuity Int
  deriving (Show, Eq, Ord, Enum, Generic)

instance Binary TeamContinuity

-- | Conditional polynomial representing score calculation for this faction.
type HiCondPoly = [HiSummand]

type HiSummand = (HiPolynomial, [Outcome])

type HiPolynomial = [(HiIndeterminant, Double)]

data HiIndeterminant =
    HiConst
  | HiLoot
  | HiSprint
  | HiBlitz
  | HiSurvival
  | HiKill
  | HiLoss
  deriving (Show, Eq, Generic)

instance Binary HiIndeterminant

-- | Outcome of a game.
data Outcome =
    Escape    -- ^ the faction escaped the dungeon alive
  | Conquer   -- ^ the faction won by eliminating all rivals
  | Defeated  -- ^ the faction lost the game in another way
  | Killed    -- ^ the faction was eliminated
  | Restart   -- ^ game is restarted; the quitter quit
  | Camping   -- ^ game is supended
  deriving (Show, Eq, Ord, Enum, Bounded, Generic)

instance Binary Outcome

teamExplorer :: TeamContinuity
teamExplorer = TeamContinuity 1

hiHeroLong, hiHeroMedium, hiHeroShort, hiDweller :: HiCondPoly

hiHeroShort =
  [ ( [(HiLoot, 100)]
    , [minBound..maxBound] )
  , ( [(HiConst, 100)]
    , victoryOutcomes )
  , ( [(HiSprint, -500)]  -- speed matters, but only if fast enough
    , victoryOutcomes )
  , ( [(HiSurvival, 10)]  -- few points for surviving long
    , deafeatOutcomes )
  ]

hiHeroMedium =
  [ ( [(HiLoot, 200)]  -- usually no loot, but if so, no harm
    , [minBound..maxBound] )
  , ( [(HiConst, 200), (HiLoss, -10)]  -- normally, always positive
    , victoryOutcomes )
  , ( [(HiSprint, -1000)]  -- speed matters, but only if fast enough
    , victoryOutcomes )
  , ( [(HiBlitz, -100)]  -- speed matters always
    , victoryOutcomes )
  , ( [(HiSurvival, 10)]  -- few points for surviving long
    , deafeatOutcomes )
  ]

-- Heroes in long crawls rejoice in loot. But speedrunning just as valuable.
hiHeroLong =
  [ ( [(HiLoot, 10000)]  -- multiplied by fraction of collected
    , [minBound..maxBound] )
  , ( [(HiConst, 15)]  -- a token bonus in case all loot lost, but victory
    , victoryOutcomes )
  , ( [(HiSprint, -20000)]  -- speedrun bonus, if below this number of turns
    , victoryOutcomes )
  , ( [(HiBlitz, -100)]  -- speed matters always
    , victoryOutcomes )
  , ( [(HiSurvival, 10)]  -- few points for surviving long
    , deafeatOutcomes )
  ]

-- Spawners get no points from loot, but try to kill
-- all opponents fast or at least hold up for long.
hiDweller = [ ( [(HiConst, 1000)]  -- no loot, so big win reward
              , victoryOutcomes )
            , ( [(HiConst, 1000), (HiLoss, -10)]
              , victoryOutcomes )
            , ( [(HiSprint, -1000)]  -- speedrun bonus, if below
              , victoryOutcomes )
            , ( [(HiBlitz, -100)]  -- speed matters
              , victoryOutcomes )
            , ( [(HiSurvival, 100)]
              , deafeatOutcomes )
            ]

victoryOutcomes :: [Outcome]
victoryOutcomes = [Escape, Conquer]

deafeatOutcomes :: [Outcome]
deafeatOutcomes = [Defeated, Killed, Restart]

nameOutcomePast :: Outcome -> Text
nameOutcomePast = \case
  Escape   -> "emerged victorious"
  Conquer  -> "vanquished all opposition"
  Defeated -> "got decisively defeated"
  Killed   -> "got eliminated"
  Restart  -> "resigned prematurely"
  Camping  -> "set camp"

nameOutcomeVerb :: Outcome -> Text
nameOutcomeVerb = \case
  Escape   -> "emerge victorious"
  Conquer  -> "vanquish all opposition"
  Defeated -> "be decisively defeated"
  Killed   -> "be eliminated"
  Restart  -> "resign prematurely"
  Camping  -> "set camp"

endMessageOutcome :: Outcome -> Text
endMessageOutcome = \case
  Escape   -> "Can it be done more efficiently, though?"
  Conquer  -> "Can it be done in a better style, though?"
  Defeated -> "Let's hope your new overlords let you live."
  Killed   -> "Let's hope a rescue party arrives in time!"
  Restart  -> "This time for real."
  Camping  -> "See you soon, stronger and braver!"

validateSingle :: FactionKind -> [Text]
validateSingle FactionKind{..} =
  [ "fname longer than 50" | T.length fname > 50 ]
  ++ [ "fskillsOther not negative:" <+> fname
     | any ((>= 0) . snd) $ Ability.skillsToList fskillsOther ]
  ++ let checkLoveHate l team =
           [ "love-hate relationship for" <+> tshow team | team `elem` l ]
     in concatMap (checkLoveHate fenemyTeams) falliedTeams
  ++ let checkDipl field l team =
           [ "self-diplomacy in" <+> field | length (elemIndices team l) > 1 ]
     in concatMap (checkDipl "fenemyTeams" fenemyTeams) fenemyTeams
        ++ concatMap (checkDipl "falliedTeams" falliedTeams) falliedTeams

-- | Validate game faction kinds together.
validateAll :: [FactionKind] -> ContentData FactionKind -> [Text]
validateAll _ _ = []  -- so far, always valid

makeData :: [FactionKind] -> [GroupName FactionKind] -> [GroupName FactionKind]
         -> ContentData FactionKind
makeData = makeContentData "FactionKind" fname ffreq validateSingle validateAll